Windows7正式版已经用了很久了,MSDN上面正式版Windows7已经发布很久了。

发现Windows7的TaskBar很漂亮,也有很多功能。例如IE下载的时候可以看到进度,可以叠加图标等等特效。

Delphi2010也发布很久了,Delphi2010号称支持Windows7的新增API,那么看看有没有TaskBar相关的API。

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

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

先来看进度条:

设计一个窗口

image

 

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
  Timer1.Enabled := not CheckBox1.Checked;
  // 不定的时候设了State就不能再设Value,否则会冲掉。
  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.

运行看看效果。

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

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

image

 

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

image

 

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

image

 
 

再来看覆盖图标

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

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

 

image

 

代码如下:

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.

 

image

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

添加按钮:

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

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

image

 

我们也可以仿照一个。

新建一个窗口

image

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('你按了按钮[id=%d]', [LoWord(Message.WParam)]));
            end;
        end;
      end;
  end;
end;

end.

 

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

image

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

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

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

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