Delphi Throbber - PullRequest
       58

Delphi Throbber

2 голосов
/ 29 апреля 2011

Как лучше всего показать, что приложение что-то делает?

Я пытался показать индикатор прогресса, но он не работал.

ОБНОВЛЕНИЕ: -------------

Индикатор выполнения работает нормально, но это не то, что мне нужно.

Я хочу показать throbber , например, какие веб-браузерыиспользуйте, так что пока что-то обновляется, оно продолжает вращаться.

Курсор также может находиться в режиме crHourGlass.

Ответы [ 6 ]

8 голосов
/ 29 апреля 2011

Попробуйте это:

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.

Unit1

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.

Изображения

image1 image2 image3 image4 image5 image6 image7 image8

animate1

6 голосов
/ 29 апреля 2011

Вы, вероятно, выполняете свою трудоемкую задачу в главном потоке.

Один из вариантов - переместить ее в фоновый поток, который позволит обслуживать вашу очередь сообщений.Вам нужно, чтобы он обслуживался для того, чтобы ваш индикатор выполнения и любой пользовательский интерфейс работали.

4 голосов
/ 29 апреля 2011

Ответ на обновленный вопрос:

  • создать анимированный GIF, например здесь
  • добавить библиотеку GIF в вашу среду (JEDI JVCL + JCL)
  • вставить TImage и загрузить сгенерированный gif
  • сделайте это видимым, если вам это нужно
1 голос
/ 29 апреля 2011

Индикатор в порядке.Вы должны позвонить Application.ProcessMessages после его изменения.

0 голосов
/ 30 апреля 2011

Из вашей длительной задачи вы можете периодически обновлять визуальный индикатор, например индикатор выполнения или что-то еще. Однако вам необходимо немедленно перерисовать изменения, вызвав Update на элементе управления, который предоставляет обратную связь.

Не используйте Application.ProcessMessages, так как это приведет к возможным проблемам с повторным входом.

0 голосов
/ 29 апреля 2011

"Как лучше всего показать, что приложение что-то делает?" установить курсор мыши на crHourGlass? или создать другую форму / фрейм / и т. д., которая обращает внимание пользователя на то, что приложение «что-то» делает, и ему нужно подождать.

...