如何设置任务栏的进度条?
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.
执行长时间操作时,某些应用程序会在任务栏中的应用程序图标后面显示一个进度条。
...
如何从 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.