如何设置任务栏的进度条?

How to set the taskbar's progress indicator?

执行长时间操作时,某些应用程序会在任务栏中的应用程序图标后面显示一个进度条。

...

如何从 Delphi 应用程序设置此进度指示器?

在现代 Delphi 版本中,您在组件面板的 Win32 部分中有 TTaskbar 组件。

将那个放在你的表格上,设置 ProgressState(比如 Normal)、ProgressMaxValue(比如 100)和 ProgressValue(对 50,比如说)。

根据我的经验,此组件存在缺陷——或者至少在早期版本中存在缺陷。所以要小心。

当然,更安全的选择是直接使用Win32 API。请参阅 ITaskbarList3.

的官方文档

这里有一个例子(link):

unit uMainTest;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ObjectArray, ShlObj, ExtCtrls, ComCtrls, ActiveX, ComObj,
  ImgList, CommCtrl, PropSys;

type
  TfrmMain = class(TForm)
    PageControl1: TPageControl;
    TabSheet1: TTabSheet;
    Button2: TButton;
    trackBar: TTrackBar;
    GroupBox5: TGroupBox;
    chkState1: TCheckBox;
    chkState2: TCheckBox;
    chkState3: TCheckBox;
    chkState4: TCheckBox;
    Button3: TButton;
    procedure FormCreate(Sender: TObject);
    procedure btProgressBarDemoClick(Sender: TObject);
    procedure btProgressStateClick(Sender: TObject);
    procedure trackBarChange(Sender: TObject);
    procedure btConfigureTasksClick(Sender: TObject);
  private
    TaskBar: ITaskBarList3;
    msgTaskbarButtonCreated: cardinal;

  protected
    procedure WndProc(var Message: TMessage); override;
  public

  end;

var
  frmMain: TfrmMain;

implementation

uses Registry, ShellApi, uFileRegistration ;

{$R *.dfm}

procedure TfrmMain.btProgressBarDemoClick(Sender: TObject);
begin
  TaskBar.SetProgressValue(Handle, trackBar.Position, trackBar.Max);
end;

procedure TfrmMain.btProgressStateClick(Sender: TObject);
var
  Flags: integer;
begin
  Flags := TBPF_NOPROGRESS;
  if chkState1.Checked then
    Flags := Flags or chkState1.Tag;
  if chkState2.Checked then
    Flags := Flags or chkState2.Tag;
  if chkState3.Checked then
    Flags := Flags or chkState3.Tag;
  if chkState4.Checked then
    Flags := Flags or chkState4.Tag;
  TaskBar.SetProgressState(Handle, Flags);
end;

procedure TfrmMain.btConfigureTasksClick(Sender: TObject);
var
  JumpList: ICustomDestinationList;
  RemovedDestination: IObjectArray;
  TaskList: IObjectCollection;
  pcMaxSlots: cardinal;
  Link1: IShellLink;
begin
  JumpList := CreateComObject(CLSID_DestinationList) as ICustomDestinationList;
  OleCheck(JumpList.BeginList(pcMaxSlots, IID_IObjectArray,
    RemovedDestination));
  try

    // A présent, on prépare une nouvelle liste de tâches à ajouter dans la
    // JumpList.
    TaskList := CreateComObject(CLSID_EnumerableObjectCollection)
      as IObjectCollection;

    // Enfin, on définit la liste des tâches en appelant AddUserTasks.
    OleCheck(JumpList.AddUserTasks(TaskList));
  except
    // En cas d'erreur, il faut annuler la liste en cours de définition
    JumpList.AbortList;
    raise; // Puis on redéclenche l'exception.
  end;
  OleCheck(JumpList.CommitList);
end;

procedure TfrmMain.FormCreate(Sender: TObject);
begin
  msgTaskbarButtonCreated := RegisterWindowMessage('TaskbarButtonCreated');

  OleCheck(SetCurrentProcessExplicitAppUserModelID('Dvp.Delphi.DemoTaskbar.1'));
end;

procedure TfrmMain.trackBarChange(Sender: TObject);
begin
  TaskBar.SetProgressValue(Handle, trackBar.Position, trackBar.Max);
end;

procedure TfrmMain.WndProc(var Message: TMessage);
begin
  if Message.Msg = msgTaskbarButtonCreated then
    TaskBar := CreateComObject(CLSID_TaskbarList) as ITaskBarList3
  else
    inherited WndProc(Message);
end;

end.