如何设置任务栏的进度指示器?

时间:2019-11-21 13:14:42

标签: delphi taskbar delphi-xe7

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

Screenshot of a taskbar with a progress bar in one of the buttons.

...

Screenshot of a taskbar with a progress bar in one of the buttons.

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

2 个答案:

答案 0 :(得分:7)

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

将其拖放到您的表单上,分别设置ProgressState(例如,NormalProgressMaxValue(例如,100)和ProgressValue(到50)。

根据我的经验,此组件存在错误-至少在早期版本中。所以要小心。

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

答案 1 :(得分:1)

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