金山词霸效果的实现(100分)

哪位朋友有实现金山词霸效果的应用程序源代码？（即将图标置于任务栏右下角）。 控件也行，望附源程序。

此类控件多的很,下面一个借花献佛中国人写的),你将源代码COPY到DELPHI里就可
以了

TNotifyIcon 控件1.01 (Build use Delphi 3.0) 说明:
作用:
往通知区加图标,并可显示,隐藏,修改这个图标.


属性(properties):
NotifyIcon:TIcon 欲加在通知区的图标
IsVisible:boolean NotifyIcon是否显示的属性
Title:string 通知区图标上的提示(最多64个字符)
PopupMenu:TPopupMenu 点击通知区图标弹出的菜单
PopupStyle:TPopupStyle 弹出菜单的方式
TPopupStyle=Set of (Left_Click,Right_Click,Left_DbClick,Right_DbClick);
方法(methods):
ShowIcon 将图标显示在通知区上
HideIcon 将通知区上的图标隐藏
ModifyIcon 修改通知区上的图标(若IsVisible=false,则不显示出来)
Create(AOwner: TComponent); override; 构造方法
Destroy; override; 析构方法
事件(Events):
OnIconMouseDown:
procedure(Sender:TObject;x,y:Word;WhoButton:TWhoButton) of Object;
(
在Mouse点击通知区上的图标时发生,x,y为Mouse在屏幕上的坐标,
WhoButton=b_Left为点击左键,WhoButton=b_Right为点击右键,
)
OnIconDoubleClick:
procedure(Sender:TObject;x,y:Word;WhoButton:TWhoButton) of Object;
(
在Mouse双击通知区上的图标时发生,x,y为Mouse在屏幕上的坐标,
WhoButton=b_Left为双击左键,WhoButton=b_Right为双击右键,
)
关于Demo:
这个演示程序给出了TNotifyIcon的基本用法.

包含文件:
NotifyIcon.dcr
NotifyIcon.pas
DemoUnit.pas
DemoUnit.dfm
PopUnit.pas
PopUnit.dfm
Demo.dpr
Readme.txt

声明:
TNotifyIcon 控件 V 1.01
1.这是一个免费控件.
2.如果你使用它,请发一个E-Mail给作者,谢谢.
3我在Delphi3.0 & 4.0 上使用成功
4.若要传播它,请完全分发上述8个文件

作者 南昌大学计算系95(1) 付昱纲 1998.8.17 21:50
E-mail fyg@163.net

unit NotifyIcon;

interface

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

const
WM_MY_Notify=WM_USER+100;
type

TPopupStyle=Set of (Left_Click,Right_Click,Left_DbClick,Right_DbClick);
TWhoButton=(b_Left,b_Right);
TMouseEvent=
procedure(Sender:TObject;x,y:Word;WhoButton:TWhoButton)
of Object;

//---------class TNotifyIcon---------
TNotifyIcon = class(TCustomControl)
private
{ Private declarations }
FIcon:TIcon;
FPdaNOTIFYICONDATA;
FTitle:string;
FIconVisible:boolean;
FPopupMenu:TPopupMenu;
FPopupStyle:TPopupStyle;
FOnIconMouseDown:TMouseEvent;
FOnIconDoubleClick:TMouseEvent;
procedure SetIcon(Icon:TICON);
procedure SetTitle(NewTitle:string);
function IsShowing:boolean;
procedure ShowIt(Accept:boolean);
procedure NotifyIconClick(var msg : TMessage);
Message WM_My_Notify;
protected
{ Protected declarations }
public
{ Public declarations }
property IsVisible:boolean read IsShowing write ShowIt;
constructor Create(AOwner: TComponent); override;
procedure ShowIcon;
procedure HideIcon;
destructor Destroy; override;
procedure ModifyIcon(NewIcon:TIcon);
procedure Paint;override;
published
{ Published declarations }
property Height default 33;
property Width default 33;
property NotifyIcon:TIcon read FIcon write SetIcon;
property Title:string read FTitle write SetTitle
property OnIconDoubleClick:TMouseEvent
read FOnIconDoubleClick write FOnIconDoubleClick;
property OnIconMouseDown:TMouseEvent
read FOnIconMouseDown write FOnIconMouseDown;
property PopupMenu:TPopupMenu read FPopupMenu write FPopupMenu;
property PopupStyle:TPopupStyle read FPopupStyle
write FPopupStyle default [];
end;

procedure Register;

implementation

procedure Register;
begin
RegisterComponents('MyControl', [TNotifyIcon]);
end;

procedure TNotifyIcon.ShowIt(Accept:boolean);
begin
if Accept=true then ShowIcon
else HideIcon;
end;

procedure TNotifyIcon.Paint;
begin
if (csDesigning in ComponentState) then
begin
Width:=33;
Height:=33;
With Canvas do
begin
Brush.Color:=clInfoBk;
Ellipse(0,0,Self.Width,Self.Height);
Font.Color:=clBlue;
Brush.Style:=bsClear;
FloodFill(5,5,clInfoBk,fsBorder);
Brush.Color:=clInfoBk;
TextOut(3,Self.Height div 2-6,'Notify');
end
end;
end;

procedure TNotifyIcon.NotifyIconClick(var msg : TMessage);
var p:TPoint;
begin
try
case msg.LParam of
WM_LBUTTONDOWN:
begin
GetCursorPos(p);
if Left_Click in FPopupStyle then
begin
SetForegroundWindow(ParentWindow);
FPopupMenu.Popup(p.x,p.y);
end;
if Assigned(FOnIconMouseDown) then
begin
FOnIconMouseDown(Self,p.x,p.y,b_Left);
end;
end;
WM_RBUTTONDOWN:
begin
GetCursorPos(p);
if Right_Click in FPopupStyle then
begin
SetForegroundWindow(ParentWindow);
FPopupMenu.Popup(p.x,p.y);
end;
if Assigned(FOnIconMouseDown) then
begin
FOnIconMouseDown(Self,p.x,p.y,b_Right);
end;
end;
WM_LBUTTONDBLCLK:
begin
GetCursorPos(p);
if Left_DbClick in FPopupStyle then
begin
SetForegroundWindow(ParentWindow);
FPopupMenu.Popup(p.x,p.y);
end;
if Assigned(FOnIconDoubleClick) then
begin
FOnIconDoubleClick(Self,p.x,p.y,b_Left);
end;
end;
WM_RBUTTONDBLCLk:
begin
GetCursorPos(p);
if Right_Click in FPopupStyle then
begin
SetForegroundWindow(ParentWindow);
FPopupMenu.Popup(p.x,p.y);
end;
if Assigned(FOnIconDoubleClick) then
begin
FOnIconDoubleClick(Self,p.x,p.y,b_Right);
end;
end;
end;
except
end;
end;

function MAKELANGID(p, s:word):Cardinal;
begin
result:= (((s)shl 10) or(p));
end;

constructor TNotifyIcon.Create(AOwner: TComponent);
begin
try
inherited Create(AOwner);
FIcon:=TIcon.Create;
Height:=36;
Width:=36;
Visible:=false;
FTitle:='Welcome';
FIconVisible:=false;
//-------------set tray info---------
ParentWindow:=TWinControl(AOwner).Handle;
New(Fpda);
With FPda^ do
begin
uCallbackMessage:=WM_MY_Notify;
cbsize:=SizeOf(FPda^);
uID:=200;
wnd:=Handle;
uFlags:=NIF_ICON+NIF_Tip+NIF_MESSAGE;
end;

if (csDesigning in ComponentState) then
begin
if GetUserDefaultLCID = MAKELANGID(LANG_CHINESE,SUBLANG_CHINESE_SIMPLIFIED) then
Application.MessageBox(
'Write by 南昌大学 付昱纲'#13#13'E-mail:fyg@163.net'#13#13' 1998.8.17',
'TNotifyIcon 控件 V 1.01',MB_OK+ MB_ICONINFORMATION)
else
Application.MessageBox(
'Write by NanChang University FuYuGang'#13#13'E-mail:fyg@163.net'#13#13' 1998.8.17',
'TNotifyIcon Component V 1.01',MB_OK+ MB_ICONINFORMATION);
end;
except
ShowMessage('TNotifyIcon Create error');
end;
end;

procedure TNotifyIcon.SetIcon(Icon:TICON);
begin
FIcon.Assign(Icon);
end;

procedure TNotifyIcon.ShowIcon;
begin
try
if FIcon.Handle=0 then
begin
Exit;
end;
if FIcon.Handle<>FPda^.hIcon then
HideIcon;
if FIconVisible=false then
begin
FPda^.hIcon:=FIcon.handle;
FIconVisible:=true;
Shell_NotifyIcon(NiM_ADD,FPda);
end;
except
ShowMessage('TNotifyIcon Show Error ');
end;
end;

procedure TNotifyIcon.HideIcon;
begin
try
if FIconVisible then
begin
FIconVisible:=false;
Shell_NotifyIcon(NiM_DELETE,FPda);
end;
except
ShowMessage('TNotifyIcon Hide Error');
end;
end;

procedure TNotifyIcon.SetTitle(NewTitle:string);
begin
FTitle:=NewTitle;
StrCopy(FPda^.szTip,PChar(FTitle));
if FIconVisible then
begin
HideIcon;
ShowIcon;
end;
end;

destructor TNotifyIcon.Destroy;
begin
try
HideIcon;
Dispose(FPda);
FIcon.Free;
inherited Destroy;
except
ShowMessage('TNotifyIcon Destroy Error');
end;
end;

procedure TNotifyIcon.ModifyIcon(NewIcon:TIcon);
begin
try
SetIcon(NewIcon);
FPda^.hIcon:=FIcon.handle;
if FIconVisible then
Shell_NotifyIcon(NiM_Modify,FPda);
except
ShowMessage('TNotifyIcon Modify Error');
end;
end;

function TNotifyIcon.IsShowing:boolean;
begin
Result:=FIconVisible;
end;

end.

我也贡献一个, 请查收.

u can use lmd components.

const wm_IconMessage = WM_USER + 100;

type
TForm1 = class(TForm)
procedure IconTray(var msg : Tmessage);message m_IconMessage;
procedure SetTrayIcon;
end;

var
Form1: TForm1;

implementation

{$R *.DFM}
procedure TForm1.FormCreate(Sender: TObject);
begin
SetTrayIcon;
end;

procedure TForm1.SetTrayIcon;
begin
nid.cbSize := Sizeof(nid);
nid.Wnd := Handle;
nid.uID := 1;
nid.uCallbackMessage := WM_ICONMESSAGE;
nid.hIcon := Icon.handle;
nid.uFlags := nif_Message or nif_icon or nif_tip;
nid.szTip := 'ÃÔÄãMP32￥·Å';
Shell_NotifyIcon(NIM_ADD,@nid);

end;

procedure TForm1.IconTray(var msg : Tmessage);
var pt :Tpoint;
begin
if msg.LParam = wm_Rbuttondown then
begin
GetCursorPos(pt);
SetForegroundWindow(Handle);
PopupMenu1.Popup(pt.x,pt.y);
end;
if msg.LParam =WM_LBUTTONdblclk then
begin
ShowWindow(Handle,sw_ShowNormal);
SetForegroundWindow(Handle);
show;
end;
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
Action := caNone;
ShowWindow(handle,sw_Hide);
ShowWindow(FindWindow(nil,@Application.Title[1]),sw_hide);
Application.ShowMainForm := False;

end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
nid.uFlags := 0;
Shell_NotifyIcon(NIM_DELETE,@nid);
MPlayer.Deinit;
end;

yifeng给的付昱纲的例子我用过，还可以。
blueBird的历程应该没问题，可惜没能看到wuyi的例子。
分数加上去了。