比較的新しいバージョンの Delphi を使用している場合、これは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;
このAnimate
クラスは、アプリケーションの開始/停止時に自己初期化および自己破壊します。アクティブにできるアニメーション プロセスは 1 つだけです。
このように使用します:
Animate.Run(
procedure( aValue : Integer)
begin
ProgressBar1.Position := aValue;
ProgressBar1.Update;
end,
1,100,5
);
コメントで説明したように、上記のコードではクラス変数とクラス関数を使用しています。欠点は、1 つのアニメーションしかアクティブにできないことです。
これはより完全なアニメーション クラスで、好きなだけアニメーションをインスタンス化できます。停止/続行の可能性、準備ができたらイベントを追加する機能、およびその他のプロパティを含む機能の拡張。
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.
アップデート:
TTimer
ベースのアニメーターの代わりに、を使用したバージョンを次に示し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
);