怎么做一个托盘图标,有消息传递时像QQ一样闪动? ( 积分: 100 )

怎么做一个托盘图标,有消息传递时像QQ一样闪动?

使用Tray Icons组件即可；很简单。

下载个 CoolTrayIcon控件 或者RzTrayIcon 里面的demo 一看就明白 如果用代码写的话得用 shellAPI单元里的
Shell_NotifyIcon

可以不用控件的。
我就是用Shell_NotifyIcon加timer手工实现的。
几句代码
能不用控件，尽量不用。

这是我在别人接触上修改的托盘控件，可以满足你的需要。
{******************************************************************************
* 系统托盘图标控件 - TTrayIcon *
* *
* 功能： 添加图标到系统托盘(System Tray)，并响应相应鼠标事件 *
* 版本： V1.01 *
* 作者： 顾中军 *
* 日期: 2005.3.6 *
* 用法： *
* 很简单，试一下就知道，这里我就不多说了 *
* 说明： *
* 这个东东完全是照搬BCB6所带的TrayIcon例子中的做法，换句话说，实际上 *
* 我只是将BCB6的代码改成Delphi而已，并未作多少改进。BCB6源码请参看其安装 *
* 目录下Examples/Controls/Source子目录中的TrayIcon.cpp/TrayIcon.h 。 *
* 总的说来，这个东东要比网上流传甚广的TSysTray的功能要强大一些，而且 *
* 我发现它对弹出菜单的处理要更完善一些（TSysTray这个东东对弹出菜单的处理 *
* 有一些Bug）。 *
* 好了，其他也没什么多说的了，让我们感谢一下Borland所提供的源码吧。 *
* 祝你愉快！！！ *
* *
* Email: iamdream@yeah.net *
******************************************************************************}

{******************************************************************************
加入气球提示功能
我在上面老兄的基础上添加了气球功能，使用的方法是使用AddBalloonTips过程来添加
气球提示，在这里我想特别提示的是，为了实现后面的气球不把前面的气球顶掉，所以
后面的气球会判断前面是否有气球在显示，若有则存入buffer，没有，则显示。若不需要
这个功能，你可以在源代码里改掉。
在这里感谢iamdream@yeah.net老兄的源码。
Email: zh7y@yahoo.com.cn
******************************************************************************}
unit JessTrayIcon;

interface

uses
Windows, Messages, SysUtils, Controls, Classes, Forms, ExtCtrls, Graphics,
Menus, ShellApi;

const
WM_SYSTEM_TRAY_NOTIFY = WM_USER + 1;
//---------------Ball Message
const
ICON_ID=3;
NIF_INFO = $10;
NIM_SETVERSION = $00000004;
NOTIFYICON_VERSION = 3;
NIM_SETFOCUS = $00000003;
NIIF_INFO = $00000001;
NIIF_WARNING = $00000002;
NIIF_ERROR = $00000003;
NIIF_NONE = $00000004;
NIN_BALLOONSHOW = WM_USER + 2;
NIN_BALLOONHIDE = WM_USER + 3;
NIN_BALLOONTIMEOUT = WM_USER + 4;
NIN_BALLOONUSERCLICK = WM_USER + 5;
NIN_SELECT = WM_USER + 0;
NINF_KEY = $1;
NIN_KEYSELECT = NIN_SELECT or NINF_KEY;

type

TJessTrayIconMessage = (imClick, imDoubleClick, imMouseDown,
imMouseUp, imLeftClickUp, imLeftDoubleClick,
imRightClickUp, imRightDoubleClick, imNone);
//---------------------JessTrayIcon----------------------------
TDUMMYUNIONNAME = Record
case Integer of
0: (uTimeout: UINT);
1: (uVersion: UINT);
end;

TNewNotifyIconData = Record
cbSize: DWORD;
Wnd: HWND;
uID: UINT;
uFlags: UINT;
uCallbackMessage: UINT;
hIcon: HICON;
szTip: array [0..127] of Char; //Version 5.0为128个，以前为64个
dwState: DWORD; //Version 5.0
dwStateMask: DWORD; //Version 5.0
szInfo: array [0..255] of Char; //Version 5.0
DUMMYUNIONNAME: TDUMMYUNIONNAME;
szInfoTitle: array [0..63] of Char; //Version 5.0
dwInfoFlags: DWORD; //Version 5.0
end;

TJessTrayIcon = class(TComponent)
private
{ Private declarations }
FData: TNewNotifyIconData;
FIsClicked: Boolean;
FIcon: TIcon;
FIconList: TImageList;
FPopupMenu: TPopupMenu;
FTimer: TTimer;
FHint: String;
FIconIndex: Integer;
FVisible: Boolean;
FHide: Boolean;
FAnimate: Boolean;
FAppRestore: TJessTrayIconMessage;
FPopupMenuShow: TJessTrayIconMessage;
FApplicationHook: TWindowHook;

FBallShowing : boolean;
FBallBuffer_Title : TStrings;
FBallBuffer_Tips : TStrings;

FOnMinimize: TNotifyEvent;
FOnRestore: TNotifyEvent;
FOnMouseMove: TMouseMoveEvent;
FOnMouseExit: TMouseMoveEvent;
FOnMouseEnter: TMouseMoveEvent;
FOnClick: TNotifyEvent;
FOnDblClick: TNotifyEvent;
FOnMouseDown: TMouseEvent;
FOnMouseUp: TMouseEvent;
FOnAnimate: TNotifyEvent;
FOnCreate: TNotifyEvent;
FOnDestroy: TNotifyEvent;
FOnActivate: TNotifyEvent;
FOnDeactivate: TNotifyEvent;
FOnBallClick: TNotifyEvent;
FBallTimeOut: TNotifyEvent;

procedure SetHint(Hint: String);
procedure SetHide(Value: Boolean);
function GetAnimateInterval: Integer;
procedure SetAnimateInterval(Value: Integer);
function GetAnimate: Boolean;
procedure SetAnimate(Value: Boolean);
procedure EndSession;
function ShiftState: TShiftState;
function GetHandle: HWND;

protected
{ Protected declarations }
procedure SetVisible(Value: Boolean); virtual;
procedure DoMessage(var Message: TMessage); virtual;
procedure DoClick; virtual;
procedure DoDblClick; virtual;
procedure DoBallClick;virtual;
procedure DoBallTimeOut;virtual;
procedure DoMouseMove(Shift: TShiftState; X, Y: Integer); virtual;
procedure DoMouseDown(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer); virtual;
procedure DoMouseUp(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer); virtual;
procedure DoOnAnimate(Sender: TObject); virtual;
procedure Notification(AComponent: TComponent;
Operation: TOperation); override;

function ApplicationHookProc(var Message: TMessage): Boolean;

procedure Loaded; override;
property Data: TNewNotifyIconData read FData;

public
{ Public declarations }
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;

procedure Minimize; virtual;
procedure Restore; virtual;
procedure Update; virtual;
procedure ShowMenu; virtual;
procedure SetIconIndex(Value: Integer); virtual;
procedure SetDefaultIcon; virtual;
procedure AddBalloonTips(TipInfo,TipTitle:string);
procedure ShowBalloonTips;

published
{ Published declarations }
property Visible: Boolean read FVisible write SetVisible default True;
property Hint: String read FHint write SetHint;
property PopupMenu: TPopupMenu read FPopupMenu write FPopupMenu;
property Hide: Boolean read FHide write SetHide;
property RestoreOn: TJessTrayIconMessage read FAppRestore write FAppRestore;
property PopupMenuOn: TJessTrayIconMessage read FPopupMenuShow write FPopupMenuShow;
property Icons: TImageList read FIconList write FIconList;
property IconIndex: Integer read FIconIndex write FIconIndex;
property AnimateInterval: Integer read GetAnimateInterval write SetAnimateInterval default 1000;
property Animate: Boolean read GetAnimate write SetAnimate default False;
property Handle: HWND read GetHandle;

property OnMinimize: TNotifyEvent read FOnMinimize write FOnMinimize;
property OnRestore: TNotifyEvent read FOnRestore write FOnRestore;
property OnClick: TNotifyEvent read FOnClick write FOnClick;
property OnMouseEnter: TMouseMoveEvent read FOnMouseEnter write FOnMouseEnter;
property OnMouseExit: TMouseMoveEvent read FOnMouseExit write FOnMouseExit;
property OnMuuseMove: TMouseMoveEvent read FOnMouseMove write FOnMouseMove;
property OnMouseUp: TMouseEvent read FOnMouseUp write FOnMouseUp;
property OnMouseDown: TMouseEvent read FOnMouseDown write FOnMouseDown;
property OnAnimate: TNotifyEvent read FOnAnimate write FOnAnimate;
property OnCreate: TNotifyEvent read FOnCreate write FOnCreate;
property OnDestroy: TNotifyEvent read FOnDestroy write FOnDestroy;
property OnActivate: TNotifyEvent read FOnActivate write FOnActivate;
property OnDeactivate: TNotifyEvent read FOnDeactivate write FOnDeactivate;
property OnBallClick: TNotifyEvent read FOnBallClick write FOnBallClick;
property BallTimeOut: TNotifyEvent read FBallTimeOut write FBallTimeOut;

end;

procedure Register;

resourcestring
sCannotCreate = 'Cannot Create System Shell Notification Icon';
sCannotRemove = 'Cannot Remove System Shell Notification Icon';

implementation

procedure Register;
begin
RegisterComponents('Standard', [TJessTrayIcon]);
end;

constructor TJessTrayIcon.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FHint := Hint;

FBallShowing := False;
FBallBuffer_Title := TStringList.Create;
FBallBuffer_Tips := TStringList.Create;

FIcon := TIcon.Create();
FTimer := TTimer.Create(Self);

FIconIndex := 0;
FIcon.Assign(Application.Icon);
FAppRestore := imDoubleClick;
FOnAnimate := DoOnAnimate;
FPopupMenuShow := imNone;
FVisible := True;
FHide := True;
FTimer.Enabled := False;
FTimer.OnTimer := OnAnimate;
FTimer.Interval := 1000;

if not (csDesigning in ComponentState) then
begin
FillChar(FData, SizeOf(TNotifyIconData), 0);
with FData do
begin
cbSize := SizeOf(TNewNotifyIconData);
Wnd := Classes.AllocateHWnd(DoMessage);
uID := UINT(Self);
hIcon := FIcon.Handle;
uFlags := NIF_ICON or NIF_MESSAGE or NIF_TIP ;
szTip:='LavaTech--Enhance the life!';
uCallbackMessage := WM_SYSTEM_TRAY_NOTIFY;
end;
FApplicationHook := ApplicationHookProc;
Update();
SetVisible(Visible);//Add by Jess
end;
end;

procedure TJessTrayIcon.AddBalloonTips(TipInfo,TipTitle:string);
begin
if not (csDesigning in ComponentState) then
begin

//-----Save to buffer
FBallBuffer_Title.Append(TipTitle);
FBallbuffer_Tips.Append(TipInfo);

if not FBallShowing then
begin
ShowBalloonTips;
end;
end
end;


procedure TJessTrayIcon.ShowBalloonTips;
begin
if FBallBuffer_Title.Count <1 then
begin
Exit;
end;
with FData do
begin
cbSize := sizeof(FData);
uFlags := uFlags or NIF_INFO;
strPLCopy(FData.szInfo, FBallBuffer_Tips.Strings[0], sizeof(FData.szInfo) - 1);
DUMMYUNIONNAME.uTimeout := 10;
strPLCopy(FData.szInfoTitle, FBallBuffer_Title.Strings[0], sizeof(FData.szInfoTitle) - 1);
dwInfoFlags := NIIF_Info;
Shell_NotifyIcon(NIM_MODIFY, @FData);
FBallShowing := True;

FBallBuffer_Title.Delete(0);
FBallBuffer_Tips.Delete(0);
end;
end;

destructor TJessTrayIcon.Destroy;
begin
if not (csDesigning in ComponentState) then
begin
Shell_NotifyIcon(NIM_DELETE, @FData);
Classes.DeallocateHWnd(FData.Wnd);
end;

if FIcon <> nil then
FIcon.Free;
if FTimer <> nil then
FTimer.Free;

FBallBuffer_Tips.Destroy;
FBallBuffer_Title.Destroy;

inherited Destroy;
end;

procedure TJessTrayIcon.Notification(AComponent: TComponent; Operation: TOperation);
begin
inherited Notification(AComponent, Operation);

if Operation = opRemove then
begin
if AComponent = FIconList then
FIconList := nil
else if AComponent = FPopupMenu then
FPopupMenu := nil;
end;
end;

procedure TJessTrayIcon.Loaded;
begin
inherited Loaded;

if FIconList = nil then
begin
FAnimate := False;
FIcon.Assign(Application.Icon);
end
else
begin
FTimer.Enabled := FAnimate;
FIconList.GetIcon(FIconIndex, FIcon);
end;
Update();
end;

procedure TJessTrayIcon.SetVisible(Value: Boolean);
begin
//if FVisible = Value then exit;

FVisible := Value;

if not (csDesigning in ComponentState) then
begin
if FVisible then
begin
if not Shell_NotifyIcon(NIM_ADD, @FData) then
raise EOutOfResources.Create(sCannotCreate);
Hide := True;
Application.HookMainWindow(FApplicationHook);
end
else
begin
if not Shell_NotifyIcon(NIM_DELETE, @FData) then
raise EOutOfResources.Create(sCannotRemove);
Hide := False;
Application.UnhookMainWindow(FApplicationHook);
end;
end;
end;

procedure TJessTrayIcon.SetHint(Hint: String);
begin
// The new hint must be different than the previous hint and less than
// 64 characters to be modified. 64 is an operating system limit.
if (FHint <> Hint) and (Length(Hint) < 64) then
begin
FHint := Hint;
StrPLCopy(FData.szTip, Hint, SizeOf(FData.szTip) - 1);

// If there is no hint then there is no tool tip.
if Length(Hint) > 0 then
FData.uFlags := FData.uFlags or NIF_TIP
else
FData.uFlags := FData.uFlags and not NIF_TIP;

Update();
end;
end;

procedure TJessTrayIcon.SetHide(Value: Boolean);
begin
FHide := Value;
if FVisible then
begin
if IsIconic(Application.Handle) then
begin
if Value then
ShowWindow(Application.Handle, SW_HIDE);
end
else if not Value then
ShowWindow(Application.Handle, SW_RESTORE);
end;
end;

function TJessTrayIcon.GetAnimateInterval: Integer;
begin
Result := FTimer.Interval;
end;

procedure TJessTrayIcon.SetAnimateInterval(Value: Integer);
begin
FTimer.Interval := Value;
end;

function TJessTrayIcon.GetAnimate: Boolean;
begin
Result := FAnimate;
end;

procedure TJessTrayIcon.SetAnimate(Value: Boolean);
begin
if (FIconList <> nil) or (csLoading in ComponentState) then
FAnimate := Value;

if (FIconList <> nil) and not(csDesigning in ComponentState) then
begin
FTimer.Enabled := Value;
FIconIndex := 0;
end;
end;

procedure TJessTrayIcon.EndSession;
begin
Shell_NotifyIcon(NIM_DELETE, @FData);
end;

function TJessTrayIcon.ShiftState: TShiftState;
begin
if GetKeyState(VK_SHIFT) < 0 then
Include(Result, ssShift);
if GetKeyState(VK_CONTROL) < 0 then
Include(Result, ssCtrl);
if GetKeyState(VK_MENU) < 0 then
Include(Result, ssAlt);
end;

procedure TJessTrayIcon.DoMessage(var Message: TMessage);
var
APoint: TPoint;
Shift: TShiftState;
begin
case Message.Msg of
WM_QUERYENDSESSION: Message.Result := 1;
WM_ENDSESSION: EndSession;
WM_SYSTEM_TRAY_NOTIFY:
begin
case Message.LParam of
WM_MOUSEMOVE:
if Assigned(FOnClick) then
begin
Shift := ShiftState();
GetCursorPos(APoint);
DoMouseMove(Shift, APoint.X, APoint.Y);
end;
WM_LBUTTONDOWN:
begin
Shift := ShiftState();
Include(Shift, ssLeft);
GetCursorPos(APoint);
DoMouseDown(mbLeft, Shift, APoint.X, APoint.Y);
FIsClicked := True;
end;
WM_LBUTTONUP:
begin
Shift := ShiftState();
Include(Shift, ssLeft);
GetCursorPos(APoint);

if Assigned(FOnClick) then
DoClick();

DoMouseUp(mbLeft, Shift, APoint.X, APoint.Y);

if FAppRestore = imLeftClickUp then
Restore();
if FPopupMenuShow = imLeftClickUp then
ShowMenu();
end;
WM_LBUTTONDBLCLK:
begin
DoDblClick();

if FAppRestore = imLeftDoubleClick then
Restore();
if FPopupMenuShow = imLeftDoubleClick then
ShowMenu();
end;
WM_RBUTTONDOWN:
begin
Shift := ShiftState();
Include(Shift, ssRight);
GetCursorPos(APoint);
DoMouseDown(mbRight, Shift, APoint.X, APoint.Y);
end;
WM_RBUTTONUP:
begin
Shift := ShiftState();
Include(Shift, ssRight);
GetCursorPos(APoint);

DoMouseUp(mbRight, Shift, APoint.X, APoint.Y);

if FAppRestore = imRightClickUp then
Restore();
if FPopupMenuShow = imRightClickUp then
ShowMenu();
end;
WM_RBUTTONDBLCLK:
begin
DoDblClick();

if FAppRestore = imRightDoubleClick then
Restore();
if FPopupMenuShow = imRightDoubleClick then
ShowMenu();
end;
WM_MBUTTONDOWN:
begin
Shift := ShiftState();
Include(Shift, ssMiddle);
GetCursorPos(APoint);

DoMouseDown(mbMiddle, Shift, APoint.X, APoint.Y);
end;
WM_MBUTTONUP:
begin
Shift := ShiftState();
Include(Shift, ssMiddle);
GetCursorPos(APoint);

DoMouseUp(mbMiddle, Shift, APoint.X, APoint.Y);
end;
WM_MBUTTONDBLCLK:
begin
DoDblClick();
end;
//--------------Ballon Tip-------------------------
NIN_BALLOONUSERCLICK:
begin
FBallShowing := False;
ShowBalloonTips;
DoBallClick();
end;
NIN_BALLOONTIMEOUT:
begin
FBallShowing := False;
ShowBalloonTips;
DoBallTimeOut();
end;
end;
end;
end;
inherited Dispatch(Message);
end;

procedure TJessTrayIcon.ShowMenu;
var
APoint: TPoint;
begin
GetCursorPos(APoint);

if (Screen.ActiveForm <> nil) and (Screen.ActiveForm.Handle <> 0) then
SetForegroundWindow(Screen.ActiveForm.Handle);

FPopupMenu.Popup(APoint.X, APoint.Y);
end;

procedure TJessTrayIcon.DoClick;
begin
if FAppRestore = imClick then
Restore();
if FPopupMenuShow = imClick then
ShowMenu();

if Assigned(FOnClick) then
FOnClick(Self);
end;

procedure TJessTrayIcon.DoBallClick;
begin
if Assigned(FOnBallClick) then
FOnBallClick(Self);
end;

procedure TJessTrayIcon.DoBallTimeOut;
begin
if Assigned(FBallTimeOut) then
FBallTimeOut(Self);
end;


procedure TJessTrayIcon.DoDblClick;
begin
if FAppRestore = imDoubleClick then
Restore();
if FPopupMenuShow = imDoubleClick then
ShowMenu();

if Assigned(FOnDblClick) then
FOnDblClick(Self);
end;

procedure TJessTrayIcon.DoMouseMove(Shift: TShiftState; X, Y: Integer);
begin
if Assigned(FOnMouseMove) then
FOnMouseMove(Self, Shift, X, Y);
end;

procedure TJessTrayIcon.DoMouseDown(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer);
begin
if FAppRestore = imMouseDown then
Restore();
if FPopupMenuShow = imMouseDown then
ShowMenu();

if Assigned(FOnMouseDown) then
FOnMouseDown(Self, Button, Shift, X, Y);
end;

procedure TJessTrayIcon.DoMouseUp(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer);
begin
if FAppRestore = imMouseUp then
Restore();
if FPopupMenuShow = imMouseUp then
ShowMenu();

if Assigned(FOnMouseUp) then
FOnMouseUp(Self, Button, Shift, X, Y);
end;

procedure TJessTrayIcon.DoOnAnimate(Sender: TObject);
begin
if IconIndex < FIconList.Count - 1 then
Inc(FIconIndex)
else
FIconIndex := 0;

SetIconIndex(FIconIndex);
Update();
end;

//---------------------------------------------------------------------------
// When the application minimizes, hide it, so only the icon in the system
// tray is visible.
//---------------------------------------------------------------------------
procedure TJessTrayIcon.Minimize;
begin
Application.Minimize();
if FHide then
ShowWindow(Application.Handle, SW_HIDE);

if Assigned(FOnMinimize) then
FOnMinimize(Self);
end;

//---------------------------------------------------------------------------
// Restore the application by making its window visible again, which is a
// little weird since its window is invisible, having no height or width, but
// that's what determines whether the button appears on the taskbar.
//---------------------------------------------------------------------------
procedure TJessTrayIcon.Restore;
begin
Application.Restore();
ShowWindow(Application.Handle, SW_RESTORE);
SetForegroundWindow(Application.Handle);

if Assigned(FOnRestore) then
FOnRestore(Self);
end;

procedure TJessTrayIcon.Update;
begin
if not (csDesigning in ComponentState) then
begin
FData.hIcon := FIcon.Handle;
if FVisible then //Modify by Jess. modify Visible to FVisible
begin
Fdata.uFlags := NIF_ICON or NIF_MESSAGE or NIF_TIP;
Shell_NotifyIcon(NIM_MODIFY, @FData);
end;
end;
end;

procedure TJessTrayIcon.SetIconIndex(Value: Integer);
begin
FIconIndex := Value;

if FIconList <> nil then
FIconList.GetIcon(FIconIndex, FIcon);

Update();
end;

function TJessTrayIcon.ApplicationHookProc(var Message: TMessage): Boolean;
begin
Result := False;

if Message.Msg = WM_SYSCOMMAND then
begin
if Message.WParam = SC_MINIMIZE then
Minimize()
else if Message.Msg = SC_RESTORE then
Restore();
end;
end;

procedure TJessTrayIcon.SetDefaultIcon;
begin
FIcon.Assign(Application.Icon);
Update();
end;

function TJessTrayIcon.GetHandle: HWND;
begin
Result := FData.Wnd;
end;

end.

TO 我爱PASCAL,
能不能给点详细的代码，我是刚学的

http://down1.tomore.com/source/20070129/2007012916072718890.rar
这个是我编的一个例子，里面有托盘的函数

如要做闪动的，做一个空白图标，和有图的图标轮换出现就是闪动效果了

谢谢了先,我先研究一下下

[]

呵呵：）大家说得够多了，ysp娃娃的方法简单，方便。最后我还想要提一下，实现楼主的需求还可以用Hook实现，不过好像麻烦了些...呵呵

多人接受答案了。