1. 技术文章
  2. Tricky thing about pointers to animate something in Delphi

Tricky thing about pointers to animate something in Delphi

由 情到浓时终转凉″ 提交于 2019-12-24 13:37:22

问题


So, I don't even know how to write the proper title.

What I want to do is to animate the position of lets say a progressbar.

One could discuss how to do this with timers and loops and so on.

However, I want to be able to do something like this:

  1. ProgressBar1.Position:=Animate(ToValue); or
  2. Animate(ProgressBar1.Position, ToValue);

Is this possible?

creating a component inherited from an integer didnt work.

I tried number 2 using pointers and made this procedure

procedure TForm1.Animate(ToValue: integer;  var Dest: Integer);
begin    
  Dest:=ToValue;
end;

and it did change the position value internally of the progress bar, but the progress bar did not change visually.

If anybody has an idea of how to do this it would be great.

Thank you!


回答1:


If you have a relative new version of Delphi, this is an animation wrapper around a TTimer using anonymous methods.

type
  Animate = class
    private
      class var fTimer : TTimer;
      class var fStartValue : Integer;
      class var fEndValue : Integer;
      class var fProc : TProc<Integer>;
      class Constructor Create;
      class Destructor Destroy;
      class procedure OnTimer(Sender : TObject);
    public
      class procedure Run( aProc : TProc<Integer>; 
                           fromValue, ToValue, AnimationDelay : Integer);
  end;

class constructor Animate.Create;
begin
  fTimer := TTimer.Create(nil);
  fTimer.Enabled := false;
  fTimer.OnTimer := Animate.OnTimer;
end;

class destructor Animate.Destroy;
begin
  fTimer.Free;
end;

class procedure Animate.OnTimer(Sender: TObject);
begin
  if Assigned(fProc) then
  begin
    if (fStartValue <= fEndValue) then
    begin
      fProc(fStartValue);
      Inc(fStartValue);
    end
    else
      fTimer.Enabled := false;
  end;
end;

class procedure Animate.Run( aProc: TProc<Integer>; 
                             fromValue, ToValue, AnimationDelay: Integer);
begin
  fTimer.Interval := AnimationDelay;
  fStartValue := fromValue;
  fEndValue := ToValue;
  fProc := aProc;
  fTimer.Enabled := (fStartValue <= fEndValue);
end;

The Animate class is self initializing and self destructing on application start/stop. Only one animation process can be active.

Use it this way :

Animate.Run(
  procedure( aValue : Integer)
  begin 
    ProgressBar1.Position := aValue;
    ProgressBar1.Update;
  end,
  1,100,5
);

As discussed in comments, the above code use class variables and class functions. Drawback is only one animation can be active.

Here is a more complete animation class, where you can instantiate as many animations you like. Expanded functionallity with possibility to stop/proceed, adding an event when ready, and some more properties. 

unit AnimatePlatform;

interface

uses
  System.Classes,System.SysUtils,Vcl.ExtCtrls;

type
  TAnimate = class
    private
      fTimer : TTimer;
      fLoopIx : Integer;
      fEndIx : Integer;
      fProc : TProc<Integer>;
      fOnReady : TProc<TObject>;
      procedure OnTimer(Sender : TObject);
      function GetRunning : boolean;
      procedure SetReady;
    public
      Constructor Create;
      Destructor Destroy; override;
      procedure Run( aProc : TProc<Integer>;
                     FromValue,ToValue,AnimationDelay : Integer); overload;
      procedure Run( aProc : TProc<Integer>;
                     FromValue,ToValue,AnimationDelay : Integer;
                     AReadyEvent : TNotifyEvent); overload;
      procedure Run( aProc : TProc<Integer>;
                     FromValue,ToValue,AnimationDelay : Integer;
                     AReadyEvent: TProc<TObject>); overload;
      procedure Stop;
      procedure Proceed;
      property ActualLoopIx : Integer read fLoopIx write fLoopIx;
      property Running : boolean read GetRunning;
      property OnReady : TProc<TObject> read fOnReady write fOnReady;
  end;

implementation

constructor TAnimate.Create;
begin
  Inherited;
  fTimer := TTimer.Create(nil);
  fTimer.Enabled := false;
  fTimer.OnTimer := Self.OnTimer;
  fOnReady := nil;
end;

destructor TAnimate.Destroy;
begin
  fTimer.Free;
  Inherited;
end;

function TAnimate.GetRunning: boolean;
begin
  Result := fTimer.Enabled;
end;

procedure TAnimate.OnTimer(Sender: TObject);
begin
  if Assigned(fProc) then
  begin
    if (fLoopIx <= fEndIx) then
    begin
      fProc(fLoopIx);
      Inc(fLoopIx);
    end;
    if (fLoopIx > fEndIx) then
      SetReady;
  end
  else SetReady;
end;

procedure TAnimate.Proceed;
begin
  fTimer.Enabled := true;
end;

procedure TAnimate.Run(aProc: TProc<Integer>; FromValue, ToValue,
  AnimationDelay: Integer; AReadyEvent: TNotifyEvent);
begin
  Run(aProc,FromValue,ToValue,AnimationDelay);
  fOnReady := AReadyEvent;
end;

procedure TAnimate.Run(aProc: TProc<Integer>; FromValue, ToValue,
  AnimationDelay: Integer; AReadyEvent: TProc<TObject>);
begin
  Run(aProc,FromValue,ToValue,AnimationDelay);
  fOnReady := AReadyEvent;
end;

procedure TAnimate.Run(aProc: TProc<Integer>; fromValue, ToValue,
  AnimationDelay: Integer);
begin
  fTimer.Interval := AnimationDelay;
  fLoopIx :=         fromValue;
  fEndIx :=          ToValue;
  fProc :=           aProc;
  fTimer.Enabled :=  true;
end;

procedure TAnimate.SetReady;
begin
  Stop;
  if Assigned(fOnReady) then
    fOnReady(Self);
end;

procedure TAnimate.Stop;
begin
  fTimer.Enabled := false;
end;

end.

Update:

Instead of a TTimer based animator, here is a version using an anonymous thread:

uses
  SyncObjs;

procedure AnimatedThread( aProc: TProc<Integer>;
                          FromValue, ToValue, AnimationDelay: Integer;
                          AReadyEvent: TNotifyEvent);
begin
  TThread.CreateAnonymousThread(
    procedure
    var
      i: Integer;
      w : TSimpleEvent;
    begin
      w := TSimpleEvent.Create(Nil,False,False,'');
      try
        for i := FromValue to ToValue do begin
          TThread.Synchronize(nil,
            procedure
            begin
              aProc(i);
            end
          );
          w.WaitFor(AnimationDelay);
        end;
      finally
        w.Free;
      end;
      if Assigned(AReadyEvent) then
        TThread.Synchronize(nil,
          procedure
          begin
            AReadyEvent(Nil);
          end
        );
    end
  ).Start;
end;

// Example call

AnimateThread(
  procedure(aValue: Integer)
  begin 
    ProgressBar1.Position := aValue;
    ProgressBar1.Update;
  end,
  1,100,5,nil
);



回答2:


You can do this easily with RTTI.

You cannot avoid writing a loop, but you can write it once and call your Animate method for any object/property you want to set. Of course, writing such a function is still tricky because you have to take into account flickering, time the UI is blocking, etc.

A very simple example would be something in the lines of:

implementation
uses RTTI;


procedure TForm1.Animate(AObj: TObject; APropertyName: string; AValue: Integer);
var
  Context: TRTTIContext;
  OType: TRTTIType;
  Prop: TRTTIProperty;
  StartValue: Integer;
begin
  Context := TRTTIContext.Create;
  OType := context.GetType(AObj.ClassType);
  Prop := OType.GetProperty(APropertyName);
  StartValue := Prop.GetValue(AObj).AsInteger;
  for AValue := StartValue to AValue do
  begin
    Prop.SetValue(AObj, AValue);
    if AObj is TWinControl then
    begin
      TWinControl(AObj).Update;
      Sleep(3);
    end;
  end;
end;


//call it like this:
procedure TForm1.Button1Click(Sender: TObject);
begin
  Animate(ProgressBar1, 'Position', 30);
  Animate(Self, 'Height', 300);
end;



回答3:


As David says, you will need to use Timers. Here's some code the demonstates the principle. I would advise that you take the idea and roll them into your own TProgressbar descendant.

Be aware that under Vista and Windows 7 TProgressBar has some built in animations when incrementing the position. This can produce odd effects when using your own animation.

You don't mention which version of Delphi you are using. This example was created using XE2. If you are using an earlier version you may need to fix the dotted unit names in the uses clause e.g. Winapi.Windows should be Windows.

Code:

unit Unit11;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.ComCtrls, Vcl.StdCtrls, Vcl.ExtCtrls,
  Vcl.Samples.Spin;

type
  TForm11 = class(TForm)
    ProgressBar1: TProgressBar;
    Timer1: TTimer;
    Button1: TButton;
    Button2: TButton;
    spnIncrement: TSpinEdit;
    Label1: TLabel;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
  private
    FDestPos: Integer;
    FProgInc: Integer;
    procedure AnimateTo(const DestPos, Increment: Integer);
  public
    { Public declarations }
  end;

var
  Form11: TForm11;

implementation

{$R *.dfm}

procedure TForm11.Button1Click(Sender: TObject);
begin
  AnimateTo(10, spnIncrement.Value);
end;

procedure TForm11.Button2Click(Sender: TObject);
begin
  AnimateTo(90, spnIncrement.Value);
end;

procedure TForm11.Timer1Timer(Sender: TObject);
begin
  if ((FProgInc > 0) and (ProgressBar1.Position + FProgInc >= FDestPos)) or
     ((FProgInc < 0) and (ProgressBar1.Position + FProgInc <= FDestPos)) then
  begin
    ProgressBar1.Position := FDestPos;

    Timer1.Enabled := FALSE;
  end
  else
  begin
    ProgressBar1.Position := ProgressBar1.Position + FProgInc;
  end;
end;

procedure TForm11.AnimateTo(const DestPos, Increment: Integer);
begin
  FDestPos := DestPos;

  FProgInc := Increment;

  if FDestPos < ProgressBar1.Position then
    FProgInc := -FProgInc;

  Timer1.Enabled := FProgInc <> 0;
end;

end.

DFM:

object Form11: TForm11
  Left = 0
  Top = 0
  BorderStyle = bsDialog
  Caption = 'Animated Progressbar'
  ClientHeight = 77
  ClientWidth = 466
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'Tahoma'
  Font.Style = []
  OldCreateOrder = False
  Position = poScreenCenter
  PixelsPerInch = 96
  TextHeight = 13
  object Label1: TLabel
    Left = 309
    Top = 42
    Width = 53
    Height = 13
    Caption = 'Increment:'
  end
  object ProgressBar1: TProgressBar
    Left = 24
    Top = 16
    Width = 417
    Height = 17
    TabOrder = 0
  end
  object Button1: TButton
    Left = 24
    Top = 39
    Width = 75
    Height = 25
    Caption = '10%'
    TabOrder = 1
    OnClick = Button1Click
  end
  object Button2: TButton
    Left = 105
    Top = 39
    Width = 75
    Height = 25
    Caption = '90%'
    TabOrder = 2
    OnClick = Button2Click
  end
  object spnIncrement: TSpinEdit
    Left = 368
    Top = 39
    Width = 73
    Height = 22
    MaxValue = 100
    MinValue = 1
    TabOrder = 3
    Value = 0
  end
  object Timer1: TTimer
    Enabled = False
    Interval = 20
    OnTimer = Timer1Timer
    Left = 240
    Top = 40
  end
end



回答4:


You can't assign anything other than an integer to a progress bar's position. So, if you want to make the position move smoothly from one value to another you need to set the position to each individual value.

There are no handy shortcuts. There's nothing available out of the box like jQuery's animate() method. You mention timers and loops. Those are the methods you need to use.



来源：https://stackoverflow.com/questions/15320370/tricky-thing-about-pointers-to-animate-something-in-delphi

标签
Delphi
pointers
jquery-animate
易学教程内所有资源均来自网络或用户发布的内容，如有违反法律规定的内容欢迎反馈！
该文章没有解决你所遇到的问题?点击提问,说说你的问题,让更多的人一起探讨吧!