德尔福震动器答案

【问题标题】：Delphi throbber德尔福震动器
【发布时间】：2011-04-29 10:01:57
【问题描述】：

显示应用程序正在做某事的最佳解决方案是什么？

我尝试显示进度指示器，但没有成功。

更新：-------------

进度条可以正常工作，但不是我想要的。

我想显示一个throbber，就像 Web 浏览器使用的一样，所以只要有东西在更新，它就会不停地转动。

光标也可以处于 crHourGlass 模式。

【问题讨论】：

“没有工作”是不精确的。怎么没用？您的两个答案对它为什么不起作用做出了相同的假设，但我们可能错了！
您要查找的词是 throbber，所以我将其添加到您的问题中。当你说你的“进度指示器”不起作用时，你仍然需要告诉我们你在说什么，然后你需要说发生了什么，以及你期望发生什么。
是的。我生成了图像，但可以看到它在移动...

标签： delphi delphi-2007 progress throbber

【解决方案1】：

试试这个：

AnimateUnit

unit AnimateUnit;

interface

uses
  Windows, Classes;

type
  TFrameProc = procedure(const theFrame: ShortInt) of object;

  TFrameThread = class(TThread)
  private
    { Private declarations }
    FFrameProc: TFrameProc;
    FFrameValue: ShortInt;
    procedure SynchedFrame();
  protected
    { Protected declarations }
    procedure Frame(const theFrame: ShortInt); virtual;
  public
    { Public declarations }
    constructor Create(theFrameProc: TFrameProc; CreateSuspended: Boolean = False); reintroduce; virtual;
  end;

  TAnimateThread = class(TFrameThread)
  private
    { Private declarations }
  protected
    { Protected declarations }
    procedure Execute(); override;
  public
    { Public declarations }
  end;

var
  AnimateThread: TAnimateThread;

implementation

{ TFrameThread }
constructor TFrameThread.Create(theFrameProc: TFrameProc; CreateSuspended: Boolean = False);
begin
  inherited Create(CreateSuspended);
  FreeOnTerminate := True;
  FFrameProc := theFrameProc;
end;

procedure TFrameThread.SynchedFrame();
begin
  if Assigned(FFrameProc) then FFrameProc(FFrameValue);
end;

procedure TFrameThread.Frame(const theFrame: ShortInt);
begin
  FFrameValue := theFrame;
  try
    Sleep(0);
  finally
    Synchronize(SynchedFrame);
  end;
end;

{ TAnimateThread }
procedure TAnimateThread.Execute();
var
  I: ShortInt;
begin
  while (not Self.Terminated) do
  begin
    Frame(0);
    for I := 1 to 8 do
    begin
      if (not Self.Terminated) then
      begin
        Sleep(120);
        Frame(I);
      end;
    end;
    Frame(0);
  end;
end;

end.

单元1

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls, ImgList;

type
  TForm1 = class(TForm)
    ImageList1: TImageList;
    Image1: TImage;
    Button1: TButton;
    Button2: TButton;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
    procedure UpdateFrame(const theFrame: ShortInt);
  end;

var
  Form1: TForm1;

implementation

uses
  AnimateUnit;

{$R *.DFM}
procedure TForm1.UpdateFrame(const theFrame: ShortInt);
begin
  Image1.Picture.Bitmap.Handle := 0;
  try
    ImageList1.GetBitmap(theFrame, Image1.Picture.Bitmap);
  finally
    Image1.Update();
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  AnimateThread := TAnimateThread.Create(UpdateFrame);
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  AnimateThread.Terminate();
end;

end.

图片

【讨论】：

这很有趣...只是可以正确获取图像，您可以将它们发送给我吗？谢谢。

【解决方案2】：

您可能正在主线程中运行耗时的任务。

一种选择是将其移至后台线程，以便为您的消息队列提供服务。您需要对其进行维护，以使您的进度条以及任何 UI 都能正常工作。

【讨论】：

【解决方案3】：

回答更新后的问题：

生成动画 gif，例如here
将 GIF 库添加到您的环境 (JEDI JVCL+JCL)
插入一个TImage并加载生成的gif
如果需要，让它可见

【讨论】：

即使另一个线程被冻结，动画 GIF 也会保持“跳动”。 OP 要求一个他必须 ping 才能更新的 throbber。

【解决方案4】：

一个指标是好的。改完后要打Application.ProcessMessages。

【讨论】：

请不要。请改用“ProgressBar.Update”。 “Application.ProcessMessages”有很多你必须处理的潜在问题；只需调用控件的“更新”即可完成您想要做的事情，速度更快，并且没有任何问题。
@Ken True，但 UI 的其余部分也将失效。当区域失效时，它不会正确地重新绘制。取消按钮（如果存在）将不起作用。等等。如果你要在主线程中运行长时间运行的任务（理想情况下你不会），那么让它工作的唯一方法就是 ProcessMessages，这会带来所有后果。
@Ken：我同意大卫的观点。我知道差异和缺点，但恕我直言，作为新手的简单解决方案，它是最好的方法。
然后改用这个：procedure KeepWindowsAlive; var M: TMsg; begin if PeekMessage(M, 0, 0, 0, pm_Remove) then begin TranslateMessage(M); DispatchMessage(M); end; end; 它没有副作用，并且比 PM 更快返回。我有几个大型的处理密集型应用程序，它们显示进度并正确处理用户响应，不使用单独的线程，并且不要调用一次 PM。
@Ken 这有所有的副作用和很少的好处！

【解决方案5】：

“表明该应用程序正在做某事的最佳解决方案是什么？” - 将鼠标光标设置为 crHourGlass？或创建另一个表单/框架/等，以提醒用户应用程序正在“做”某事，他需要等待。

【讨论】：

【解决方案6】：

从您的冗长任务中，您可以偶尔更新视觉指示器，例如进度条或其他任何内容。但是，您需要通过在提供反馈的控件上调用 Update 来立即重绘更改。

不要使用Application.ProcessMessages，因为这会引入可能的重入问题。

【讨论】：