Question

所以，我甚至不知道如何写出正确的标题。

我想要做的是设置一个进度条的位置动画。

人们可以讨论如何使用定时器和循环等来实现这一点。

但是，我希望能够做到这样的事情：

ProgressBar1.Position：=动画（ToValue）; 或
Animate（ProgressBar1.Position，ToValue）;

这可能吗？

创建从整数继承的组件无效。

我使用指针尝试了数字2并完成了这个程序

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

它确实改变了进度条内部的位置值，但进度条在视觉上没有改变。

如果有人知道如何做到这一点就会很棒。

谢谢！

Answer 1

如果您有相对较新版本的Delphi，这是使用TTimer的{{1}}周围的动画包装。

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

正如评论中所讨论的，上面的代码使用了类变量和类函数。缺点是只有一个动画可以激活。

这是一个更完整的动画类，您可以在其中实例化您喜欢的动画。扩展功能，可以停止/继续，准备好时添加事件，以及更多属性。

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

<强>更新

而不是基于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.的动画师，这是使用anonymous thread的版本：

TTimer

Answer 2

您可以使用RTTI轻松完成此操作。

您无法避免编写循环，但您可以编写一次并为要设置的任何对象/属性调用 Animate 方法。当然，编写这样的函数仍然很棘手，因为你必须考虑闪烁，UI阻塞的时间等等。

一个非常简单的例子就是：

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

正如大卫所说，你需要使用计时器。这里有一些代码证明了原理。我建议你接受这个想法并将它们卷入你自己的TProgressbar后代。

请注意，在Vista和Windows 7下，TProgressBar在增加位置时会有一些内置动画。使用自己的动画时，这会产生奇怪的效果。

您没有提到您使用的是哪个版本的Delphi。此示例是使用XE2创建的。如果您使用的是早期版本，则可能需要修复uses子句中的虚线单元名称，例如Winapi.Windows应该是Windows。

<强>代码：

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

您不能将除整数之外的任何内容分配到进度条的位置。因此，如果您想使位置从一个值平滑移动到另一个值，则需要将位置设置为每个单独的值。

没有方便的快捷方式。像jQuery的animate（）方法一样没有开箱即用的功能。你提到计时器和循环。这些是您需要使用的方法。

关于在Delphi中制作动画的指针的棘手问题

4 个答案: