如何设置任务栏的进度指示器？答案

【问题标题】：How to set the taskbar's progress indicator?如何设置任务栏的进度指示器？
【发布时间】：2019-11-21 13:14:42
【问题描述】：

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

...

如何在 Delphi 应用程序中设置此进度指示器？

【问题讨论】：

当您将图像添加到 Q 时，请将“在此处输入图像描述”占位符替换为图像的信息描述（例如“任务栏的屏幕截图，其中一个按钮中有进度条”）。使用屏幕阅读器的视障用户会发现该文本更有帮助。此外，像 Google 这样的搜索引擎会更好地理解图像。
这是任务按钮，而不是栏。该栏包含所有按钮。
stackoverflow.com/a/5816222/4299358 也适用 - 这不是出现在您的搜索结果中吗？
另外：stackoverflow.com/questions/8633389/…（在右侧的“相关”面板中）。
很奇怪，两个问题都不在“类似问题”框中

标签： delphi taskbar delphi-xe7

【解决方案1】：

在现代 Delphi 版本中，TTaskbar 组件位于组件面板的 Win32 部分。

把那个放到你的表单上，设置ProgressState（比如Normal）、ProgressMaxValue（比如100）和ProgressValue（比如50）。

根据我的经验，这个组件是有缺陷的——或者至少它在早期版本中存在。所以要小心。

当然，更安全的选择是直接使用 Win32 API。请参阅ITaskbarList3 的官方文档。

【讨论】：

"根据我的经验，这个组件是有缺陷的——或者至少它在早期版本中存在"——它仍然是
是的。越野车。 FastMM 在使用该控件后报告内存泄漏。
似乎在 Delphi 11 中工作正常。FastMM 也不报告内存泄漏。

【解决方案2】：

这里有一个例子 (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.

【讨论】：