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

原文: http://blog.csdn.net/wr960204/archive/2009/10/13/4662735.aspx

 

一提到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( ' 你按了按钮[id=%d] ' , [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功能.