在线时间:8:00-16:00
迪恩网络APP
随时随地掌握行业动态
扫描二维码
关注迪恩网络微信公众号
原文: http://blog.csdn.net/wr960204/archive/2009/10/13/4662735.aspx
一提到Taskbar相关,首先就想到ITaskBarList不同版本接口.到shlobj单元一看,果然增加了ITaskbarList3,ITaskbarList4两个新版本的接口. 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 的覆盖图标
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. 运行起来.按一下按钮.效果如下图: 注意哦,你的程序除非是Only for Windows7的.否则要判断一下操作系统版本号.再决定是否调用新的TaskBar功能.
|
2023-10-27
2022-08-15
2022-08-17
2022-09-23
2022-08-13
请发表评论