Tricky thing about pointers to animate something in Delphi - delphi

Question

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:
ProgressBar1.Position:=Animate(ToValue);
or
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!

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

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

Answer 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

Answer 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.