Windows7新的Taskbar 在 Delphi 2010 中的编程应用

一提到Taskbar相关,首先就想到ITaskBarList不同版本接口.到shlobj单元一看,果然增加了ITaskbarList3,ITaskbarList4两个新版本的接口.

老办法CreateComObject(CLSID_TaskbarList)就行了.返回的是一个ITaskBarList接口.看具体的操作系统,返回的是你操作系统所能支持的最高版本的ITaskBarList.

TaskBar 的 进度条

设计一个窗口

unit Unit1;

interface

uses

Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

Dialogs, ShlObj, ActiveX, ComObj, ExtCtrls, StdCtrls;

type

TForm1 = class(TForm)

Timer1: TTimer;

GroupBox1: TGroupBox;

CheckBox2: TCheckBox;

CheckBox3: TCheckBox;

CheckBox1: TCheckBox;

CheckBox4: TCheckBox;

procedure FormCreate(Sender: TObject);

procedure Timer1Timer(Sender: TObject);

procedure CheckBox1Click(Sender: TObject);

private

{ Private declarations }

FPos : Int64;

FMax : Int64;

FTaskBarList : ITaskbarList4;

function SetProgressState():Integer;

public

{ Public declarations }

end;

var

Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.CheckBox1Click(Sender: TObject);

begin

SetProgressState();

end;

procedure TForm1.FormCreate(Sender: TObject);

begin

FTaskBarList := CreateComObject(CLSID_TaskbarList) as ITaskbarList4;

FPos := 0;

FMax := 200;

SetProgressState();

end;

function TForm1.SetProgressState: Integer;

begin

Result := TBPF_NOPROGRESS;

if CheckBox1.Checked then

Result := Result or TBPF_INDETERMINATE;

if CheckBox2.Checked then

Result := Result or TBPF_NORMAL;

if CheckBox3.Checked then

Result := Result or TBPF_ERROR;

if CheckBox4.Checked then

Result := Result or TBPF_PAUSED;

FTaskBarList.SetProgressState(Handle, Result);

end;

procedure TForm1.Timer1Timer(Sender: TObject);

begin

if (FPos < FMAX) then

Inc(FPos, 10)

else

FPos := 0;

FTaskBarList.SetProgressValue(Handle, FPos, FMax);

end;

end.

运行看看效果.

不定的:进度颜色的边缘是渐变的

正常的:就是绿色的进度条.

出错的:就是红色的进度条.

暂停的:就是黄色的进度条

TaskBar 的覆盖图标

就是可以再任务栏图标上再覆盖一个小图标,可以用表示状态之类的

新建一个窗口.放置一个ImageList,添加几个icon.再放一个Timer,我们用定时器来不停地变换覆盖图标.如果你的图标设置的足够好,还可以模拟动画效果啊.

unit Unit1;

interface

uses

Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

Dialogs, ShlObj, ActiveX, ComObj, ExtCtrls, StdCtrls, ImgList;

type

TForm1 = class(TForm)

Button1: TButton;

ImageList1: TImageList;

Timer1: TTimer;

procedure FormCreate(Sender: TObject);

procedure FormDestroy(Sender: TObject);

procedure Timer1Timer(Sender: TObject);

private

{ Private declarations }

FTaskBarList : ITaskbarList4;

FIcon : TIcon;

FIconIndex : Integer;

public

{ Public declarations }

end;

var

Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);

begin

FTaskBarList := CreateComObject(CLSID_TaskbarList) as ITaskbarList4;

FIcon := TIcon.Create;

end;

procedure TForm1.FormDestroy(Sender: TObject);

begin

FIcon.Free;

end;

procedure TForm1.Timer1Timer(Sender: TObject);

begin

if FIconIndex < ImageList1.Count then

begin

Inc(FIconIndex);

end

else

begin

FIconIndex := 0;

end;

ImageList1.GetIcon(FIconIndex, FIcon);

FTaskBarList.SetOverlayIcon(Handle, FIcon.Handle, '');

end;

end.

看到我的程序图标右下角的小图标了吗.就是这个样子了.

在TaskBar上添加按钮

新版迅雷在Windows7上运行的时候会在缩略图上添加三个按钮.

可以实现任务的添加,下载,暂停等功能.

我们也可以仿照一个.

新建一个窗口

unit Unit1;

interface

uses

Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

Dialogs, ShlObj, ActiveX, ComObj, ExtCtrls, StdCtrls, ImgList;

type

TForm1 = class(TForm)

Button1: TButton;

procedure Button1Click(Sender: TObject);

procedure FormDestroy(Sender: TObject);

procedure FormCreate(Sender: TObject);

private

{ Private declarations }

FTaskBarList: ITaskbarList4;

btnIcon : TIcon;

Fbtns: array [0 .. 2] of TThumbButton;

protected

procedure WndProc(var Message: TMessage); override;

public

{ Public declarations }

end;

var

Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);

var

I: Integer;

begin

ZeroMemory(@Fbtns, SizeOf(TThumbButton) * length(Fbtns));

for I := Low(Fbtns) to High(Fbtns) do

begin

Fbtns[I].dwMask := THB_ICON or THB_TOOLTIP or THB_FLAGS;

Fbtns[i].hIcon := btnIcon.Handle;

Fbtns[I].dwFlags := THBF_ENABLED;

Fbtns[I].iId := I;

Fbtns[I].szTip := 'ABCD';

end;

// 这里什么图也没给,出现的按钮都是没有图标的

FTaskBarList.ThumbBarAddButtons(Handle, length(Fbtns), @Fbtns);

end;

procedure TForm1.FormCreate(Sender: TObject);

begin

FTaskBarList := CreateComObject(CLSID_TaskbarList) as ITaskbarList4;

FTaskBarList.HrInit();

btnIcon := TIcon.Create;

btnIcon.LoadFromFile('c:\AquaValue2.ico');

end;

procedure TForm1.FormDestroy(Sender: TObject);

begin

btnIcon.Free;

end;

procedure TForm1.WndProc(var Message: TMessage);

begin

inherited;

case Message.Msg of

WM_COMMAND:

begin

case HiWord(Message.WParam) of

THBN_CLICKED:

begin

ShowMessage(Format('你按了按钮[, [LoWord(Message.WParam)]));

end;

end;

end;

end;

end;

end.

运行起来.按一下按钮.效果如下图:

但是现在还有个问题困扰了我半天.就是MSDN上说点击了按钮会受到WM_COMMAND消息.我也在WndProc中做了处理.但是不论怎样都收不到.正要放弃的时候突然灵光一闪.会不会是在调试状态运行和实际运行有啥区别呢?

于是找到编译好的EXE文件双击执行.哈哈,一切OK.虽然不知道是什么问题引起的.但是肯定和VCL或者Delphi的IDE调试环境有关.我又用C#和VC分别验证了一下.他们在调试状态下就没有这个问题.这只是一个小麻烦问题不大.呵呵.

新的ITaskBarList接口还有其他的一些方法.不过最常用的都是前面的几个.都很简单.有了前面的基础这些试一下就知道怎么用了.

注意哦,你的程序除非是Only for Windows7的.否则要判断一下操作系统版本号.再决定是否调用新的TaskBar功能.