托盘 ( 积分: 0 )

...窗体最小化时变托盘,按关闭时退出的原码........
菜鸟..
谢谢...
请发邮箱l13712807597@163.com

C:/Program Files/Borland/Delphi6/Source/Vcl/ScktSrvr.dpr
你可以参考一下Borland的写法,虽然这个程序不是针对托盘的,但它用到这部分了,还有服务部分.

unit Unit1;
interface
uses
Windows, Messages,shellapi, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, Menus;
const
ICON_ID=1;
//ICON腔ID梓祩
MI_ICONEVENT=WM_USER+1;
//赻隅砱ICON岈璃秏洘
type
TForm1 = class(TForm)
PopupMenu1: TPopupMenu;
add1: TMenuItem;
enable1: TMenuItem;
procedure FormClose(Sender: TObject;
var Action: TCloseAction);
procedure FormCreate(Sender: TObject);
procedure FormActivate(Sender: TObject);
procedure add1Click(Sender: TObject);
procedure enable1Click(Sender: TObject);
private
{ Private declarations }
{ Private declarations }
NormalIcon,DisabledIcon:TIcon;
//淏都睿囮虴謗笱錶狟腔芞梓
Status:Boolean;
//梓祩"埰勍妏蚚"遜岆"輦砦妏蚚"
procedure InstallIcon;
procedure ChangeIcon(s:Boolean);
procedure UnInstallIcon;
procedure IconOnClick(var message:TMessage);
message MI_ICONEVENT;
//眸袙赻隅砱秏洘MI_ICONEVENT腔徹最IconOnClick腔汒隴
public
{ Public declarations }
end;

var
Form1: TForm1;
implementation
uses Unit2;
{$R *.dfm}
procedure TForm1.ChangeIcon(s:Boolean);
//赻隅砱徹最ChangeIconㄛ蜊曹掛最唗婓硌尨袨怓戲腔芞梓
var
IconData:TNotifyIconData;
begin

IconData.cbSize:=SizeOf(IconData);
IconData.Wnd:=Handle;
IconData.uID:=ICON_ID;
if s=False then
//輦砦妏蚚
begin

IconData.hIcon:=DisabledIcon.Handle;
Status:=False;

end
else
//埰勍妏蚚
begin

IconData.hIcon:=Normalicon.Handle;
Status:=True;
end;

IconData.uFlags:=NIF_ICON;
Shell_NotifyIcon(NIM_MODIFY,@IconData);
end;

procedure TForm1.IconOnClick(var message:TMessage);
//揭燴扷梓婓硌尨袨怓戲勤茼腔芞梓奻腔等僻岈璃
var
p:TPoint;
begin

//彆偌狟腔岆扷梓酘瑩ㄛ甜埰勍珆尨ㄛ寀珆尨Form2
if((message.lParam=WM_LBUTTONDOWN) and (Status=True)) then

Form2.Show;
//彆偌狟腔岆扷梓衵瑩ㄛ寀珆尨粟堤粕等
if(message.lParam=WM_RBUTTONDOWN)then

begin

GetCursorPos(p);
PopupMenu1.Popup(p.x,p.y);
end;

end;

procedure TForm1.InstallIcon;
//假蚾芞梓
var
IconData:TNotifyIconData;
begin

NormalIcon:=TIcon.Create;
DisabledIcon:=TIcon.Create;
NormalIcon.LoadFromFile('normal.ico');
//埰勍妏蚚袨怓狟腔芞梓
DisabledIcon.LoadFromFile('disable.ico');
//輦砦妏蚚袨怓狟腔芞梓
IconData.cbSize:=SizeOf(IconData);
IconData.Wnd:=Handle;
IconData.uID:=ICON_ID;
IconData.uFlags:=NIF_ICON or NIF_MESSAGE or NIF_TIP;
IconData.uCallBackMessage:=MI_ICONEVENT;
IconData.hIcon:=NormalIcon.Handle;
IconData.szTip:='跤硌尨袨怓戲樓芞梓腔瞰最';
//扷梓唑婓袨怓硌尨戲勤茼腔芞梓奻奀腔枑尨陓洘
Shell_NotifyIcon(NIM_ADD,@IconData);
end;

procedure TForm1.UnInstallIcon;
//迠婥芞梓
var
IconData:TNotifyIconData;
begin

IconData.cbSize:=SizeOf(IconData);
IconData.Wnd:=Handle;
IconData.uID:=ICON_ID;
Shell_NotifyIcon(NIM_DELETE,@IconData);
end;
procedure TForm1.FormClose(Sender: TObject;
var Action: TCloseAction);
begin

UnInstallIcon;
//迠婥芞梓
NormalIcon.Free;
DisabledIcon.Free;
//庋溫謗跺芞梓訧埭
end;

procedure TForm1.FormCreate(Sender: TObject);
begin

Status:=True;
InstallIcon;
//假蚾芞梓
ChangeIcon(True);
//蜊曹芞梓峈normal袨怓
ShowWindow(Application.Handle,SW_HIDE);
//笐紲翋敦极
SetWindowLong(Application.Handle,GWL_EXSTYLE,WS_EX_TOOLWINDOW);
//婓遙袨怓戲奻祥珆尨最唗芞梓
end;

procedure TForm1.FormActivate(Sender: TObject);
begin

Form1.width:=0;
Form1.Height:=0;
ShowWindow(Application.Handle,SW_HIDE);
//笐紲Form1
end;

procedure TForm1.add1Click(Sender: TObject);
begin

Form2.Show;
//珆尨翋敦极
end;

procedure TForm1.enable1Click(Sender: TObject);
begin

if (Status=True) then

//跦擂袨怓載蜊粕等砐梓枙
begin

ChangeIcon(False);

end
else

begin

ChangeIcon(True);

end;

end;


end.

ding

(*
fnugrytrayicon.pas
version 1.0.0.1
TFnugryTrayIcon - a simple tray icon component.
Copyright (C) 1997-98 Gleb Yourchenko
Contact:
eip__@hotmail.com
Please include "TFnugryTrayIcon" in the subject string.
*)
unit FnugryTrayIcon;
interface
uses
Windows, ShellAPI, SysUtils, Messages, Classes, Menus, Graphics;
type
ETrayIconError = class(Exception);
TFnugryTrayIcon = class(TComponent)
private
FIconData :TNotifyIconData;
FHandle :HWND;
FRightMenu :TPopupMenu;
FLeftMenu :TPopupMenu;
FIcon :TIcon;
FTip :String;
FOnChange :TNotifyEvent;
FOnMouseMove :TNotifyEvent;
FOnLBtnDown :TNotifyEvent;
FOnRBtnDown :TNotifyEvent;
FOnLBtnUp :TNotifyEvent;
FOnRBtnUp :TNotifyEvent;
FOnLBtnDblClk :TNotifyEvent;
FOnRBtnDblClk :TNotifyEvent;
procedure SetVisible(Value :Boolean);
function GetVisible :Boolean;
procedure SetIcon(Value :TIcon);
procedure SetTip(const Value :String);
procedure SetRightMenu(Value :TPopupMenu);
procedure SetLeftMenu(Value :TPopupMenu);
procedure AllocateTrayIcon;
procedure ReleaseTrayIcon;
procedure UpdateTrayIcon;
procedure TrayWndProc(var Msg :TMessage);
procedure evIconChange(Sender :TObject);
protected
procedure CheckError(fCond :Boolean;
MsgID :Integer);
procedure MouseMove;
virtual;
procedure MouseLBtnUp;
virtual;
procedure MouseRBtnUp;
virtual;
procedure MouseLBtnDown;
virtual;
procedure MouseRBtnDown;
virtual;
procedure MouseLBtnDblClk;
virtual;
procedure MouseRBtnDblClk;
virtual;
procedure Notification(AComponent: TComponent;
Operation: TOperation);
override;
procedure Change;
virtual;
public
constructor Create(AOwner :TComponent);
override;
destructor Destroy;
override;
published
property Icon :TIcon
read FIcon write SetIcon;
property RightMenu :TPopupMenu
read FRightMenu write SetRightMenu;
property LeftMenu :TPopupMenu
read FLeftMenu write SetLeftMenu;
property Tip :String
read FTip write SetTip;
property Visible :Boolean
read GetVisible write SetVisible;
property OnChange :TNotifyEvent
read FOnChange write FOnChange;
property OnMouseMove :TNotifyEvent
read FOnMouseMove write FOnMouseMove;
property OnMouseLBtnDown :TNotifyEvent
read FOnLBtnDown write FOnLBtnDown;
property OnRBtnDown :TNotifyEvent
read FOnRBtnDown write FOnRBtnDown;
property OnMouseLBtnUp :TNotifyEvent
read FOnLBtnUp write FOnLBtnUp;
property OnMouseRBtnUp :TNotifyEvent
read FOnRBtnUp write FOnRBtnUp;
property OnMouseLBtnDblClk :TNotifyEvent
read FOnLBtnDblClk write FOnLBtnDblClk;
property OnMouseRBtnDblClk :TNotifyEvent
read FOnRBtnDblClk write FOnRBtnDblClk;
end;


procedure Register;
implementation
uses
forms;
procedure Register;
begin
RegisterComponents('Fnugry UI', [TFnugryTrayIcon]);
end;

{$Resource FnugryTrayIcon.Res}
{$Include FnugryTrayIcon.Inc}
const
WM_ICONNOTIFY = WM_USER + $100;

procedure TFnugryTrayIcon.SetVisible(Value :Boolean);
begin
if Value <> Visible then
begin
if Value then
AllocateTrayIcon
else
ReleaseTrayIcon;
Change;
end;
end;

function TFnugryTrayIcon.GetVisible :Boolean;
begin
result := FHandle <> 0;
end;

procedure TFnugryTrayIcon.SetIcon(Value :TIcon);
begin
assert(assigned(FIcon));
FIcon.Assign(Value);
if Visible then
UpdateTrayIcon;
end;

procedure TFnugryTrayIcon.SetTip(const Value :String);
begin
if Value <> FTip then
begin
FTip := Value;
if Visible then
UpdateTrayIcon;
Change;
end;
end;

procedure TFnugryTrayIcon.SetRightMenu(Value :TPopupMenu);
begin
FRightMenu := Value;
end;

procedure TFnugryTrayIcon.SetLeftMenu(Value :TPopupMenu);
begin
FLeftMenu := Value;
end;

procedure TFnugryTrayIcon.Notification(
AComponent: TComponent;
Operation: TOperation);
begin
if ( Operation = opRemove ) then
if AComponent = FRightMenu then
FRightMenu := Nil
else
if AComponent = FLeftMenu then
FLeftMenu := Nil;
end;

procedure TFnugryTrayIcon.Change;
begin
if assigned(FOnChange) then
FOnChange(Self);
end;

procedure TFnugryTrayIcon.AllocateTrayIcon;
begin
assert(assigned(FIcon));
if FHandle = 0 then
begin
FHandle := AllocateHWnd(TrayWndProc);
CheckError(FHandle <> 0, msg_err_allocwnd);
try
fillchar(FIconData, Sizeof(FIconData), 0);
FIconData.cbSize := sizeof(FIconData);
FIconData.uFlags := NIF_ICON OR NIF_MESSAGE OR NIF_TIP;
FIconData.uCallbackMessage := WM_ICONNOTIFY;
FIconData.Wnd := FHandle;
FIconData.hIcon := FIcon.Handle;
StrCopy(FIconData.szTip, PChar(FTip));
CheckError(Shell_NotifyIcon(NIM_ADD, @FIconData), msg_err_trayadd);
except
DeallocateHWnd(FHandle);
FHandle := 0;
raise;
end;
end;
end;

procedure TFnugryTrayIcon.ReleaseTrayIcon;
begin
if FHandle <> 0 then
begin
CheckError(Shell_NotifyIcon(NIM_DELETE, @FIconData), msg_err_traydelete);
DeallocateHWnd(FHandle);
FHandle := 0;
end;
end;

procedure TFnugryTrayIcon.UpdateTrayIcon;
begin
assert(FHandle <> 0);
FIconData.cbSize := sizeof(FIconData);
FIconData.Wnd := FHandle;
FIconData.uFlags := NIF_ICON OR NIF_TIP;
FIconData.uCallbackMessage := WM_ICONNOTIFY;
FIconData.Wnd := FHandle;
FIconData.hIcon := FIcon.Handle;
StrCopy(FIconData.szTip, PChar(FTip));
CheckError(Shell_NotifyIcon(NIM_MODIFY, @FIconData), msg_err_traymodify);
end;

constructor TFnugryTrayIcon.Create(AOwner :TComponent);
begin
inherited Create(AOwner);
FIcon := TIcon.Create;
FIcon.ReleaseHandle;
FIcon.Handle := LoadIcon(0, IDI_APPLICATION);
FIcon.OnChange := evIconChange;
end;

destructor TFnugryTrayIcon.Destroy;
begin
if Visible then
ReleaseTrayIcon;
FTip := '';
FIcon.Free;
inherited Destroy;
end;

procedure TFnugryTrayIcon.CheckError(fCond :Boolean;
MsgID :Integer);
begin
if not fCond then
raise ETrayIconError.CreateRes(MsgID);
end;

procedure TFnugryTrayIcon.TrayWndProc(var Msg :TMessage);
begin
msg.result := 0;
case Msg.lParam of
WM_MOUSEMOVE : MouseMove;
WM_LBUTTONDBLCLK : MouseLBtnDblClk;
WM_RBUTTONDBLCLK : MouseRBtnDblClk;
WM_LBUTTONUP : MouseLBtnUp;
WM_RBUTTONUP : MouseRBtnUp;
WM_LBUTTONDOWN : MouseLBtnDown;
WM_RBUTTONDOWN : MouseRBtnDown;
else
msg.result := DefWindowProc(FHandle, Msg.Msg, msg.wParam, msg.lParam);
end;
end;

procedure TFnugryTrayIcon.MouseMove;
begin
if assigned(FOnMouseMove) then
FOnMouseMove(Self);
end;

procedure TFnugryTrayIcon.MouseLBtnUp;
var
ptCursor :TPoint;
begin
if assigned(FLeftMenu) then
begin
GetCursorPos(ptCursor);
FLeftMenu.Popup(ptCursor.x, ptCursor.y);
end
else
if assigned(FOnLBtnUp) then
FOnLBtnUp(Self);
end;

procedure TFnugryTrayIcon.MouseRBtnUp;
var
ptCursor :TPoint;
begin
if assigned(FRightMenu) then
begin
GetCursorPos(ptCursor);
FRightMenu.Popup(ptCursor.x, ptCursor.y);
end
else
if assigned(FOnRBtnUp) then
FOnRBtnUp(Self);
end;

procedure TFnugryTrayIcon.MouseLBtnDown;
begin
if assigned(FOnLBtnDown) then
FOnLBtnDown(Self);
end;

procedure TFnugryTrayIcon.MouseRBtnDown;
begin
if assigned(FOnRBtnDown) then
FOnRBtnDown(Self);
end;

procedure TFnugryTrayIcon.MouseLBtnDblClk;
begin
if assigned(FOnLBtnDblClk) then
FOnLBtnDblClk(Self);
end;

procedure TFnugryTrayIcon.MouseRBtnDblClk;
begin
if assigned(FOnRBtnDblClk) then
FOnRBtnDblClk(Self);
end;

procedure TFnugryTrayIcon.evIconChange(Sender :TObject);
begin
if Visible then
UpdateTrayIcon;
end;

end.

我写的托盘控制程序。
最小化后到托盘。
unit KeyCtr;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, Menus,ShellAPI, ExtCtrls, ImgList, Buttons,TFlatSpeedButtonUnit;
type
TForm1 = class(TForm)
popMenu: TPopupMenu;
N1: TMenuItem;
N2: TMenuItem;
N3: TMenuItem;
N4: TMenuItem;
img1: TImage;
img2: TImage;
btHide: TFlatSpeedButton;
Label1: TLabel;
Image1: TImage;
N5: TMenuItem;
lbState: TLabel;
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure N4Click(Sender: TObject);
procedure N2Click(Sender: TObject);
procedure N1Click(Sender: TObject);
procedure btHideClick(Sender: TObject);
procedure FormCloseQuery(Sender: TObject;
var CanClose: Boolean);
procedure FormKeyPress(Sender: TObject;
var Key: Char);
private
{ Private declarations }
IconData:TNotifyIconData;
procedure HotKeyDown(var Msg: Tmessage);
message WM_HOTKEY;
procedure WndProc(var Msg: TMessage);
override;
public
{ Public declarations }
protected
end;

var
Form1: TForm1;
PgDnid:Integer;
PgUpid:Integer;
Flag:Integer;
tmpstr:string;
closeflag:boolean;

implementation
{$R *.DFM}

procedure TForm1.HotKeyDown(var Msg: Tmessage);
begin
if msg.LParamHi=VK_PRIOR then
begin
//ShowMessage('');
KeyBd_Event(VK_HOME, MapVirtualKey(VK_PRIOR, 0), 0, 0);
end;

if msg.LParamHi=VK_NEXT then
begin
KeyBd_Event(VK_END, MapVirtualKey(VK_END, 0), 0, 0);
end;
end;

//控制托盘图标
procedure TForm1.WndProc(var Msg: TMessage);
var
P: TPoint;
begin
//获取小图标点击事件
if Msg.Msg = WM_USER + 100 then
case Msg.LParam of
WM_RBUTTONDOWN:
begin
setActiveWindow(Handle);
//设置窗口的次序,否则菜单无法消失，MS的bug
GetCursorPos(P);
popMenu.Popup(P.x, P.y);
end;
WM_LBUTTONDBLCLK:
begin
Form1.WindowState:=wsNormal;
Show;
end;
end;
inherited;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
Flag:=1;
lbState.Caption:='当前状态：Home , End';

//注册热键
PgUpid:=GlobalAddAtom('hotkey_PgUp');
PgDnid:=GlobalAddAtom('hotkey_PgDn');
//RegisterHotKey(handle,id,mod_control,81);
RegisterHotKey(handle,PgUpid,0,VK_PRIOR);
RegisterHotKey(handle,PgDnid,0,VK_NEXT);
//控制托盘显示
with IconDatado
begin
cbSize := SizeOf(IconData);
Wnd := Handle;
uID := 100;
uFlags := NIF_MESSAGE + NIF_ICON + NIF_TIP;
uCallBackMessage := WM_USER + 100;
//hIcon := Application.Icon.Handle;
IconData.hIcon:=img1.Picture.Icon.Handle;
szTip := 'MyHotKey';
Shell_NotifyIcon(NIM_ADD, @IconData);
end;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
//退出时取消热键定义
UnRegisterHotKey(handle,PgUpid);
UnRegisterHotKey(handle,PgDnid);
//退出时消去托盘图标
Shell_NOtifyIcon(NIM_DELETE, @IconData);
end;

procedure TForm1.N4Click(Sender: TObject);
begin
closeflag:=true;
Form1.Close
end;

//恢复
procedure TForm1.N2Click(Sender: TObject);
begin
UnRegisterHotKey(handle,PgUpid);
UnRegisterHotKey(handle,PgDnid);
IconData.hIcon:=img2.Picture.Icon.Handle;
Shell_NOtifyicon(NIM_MODIFY,@IconData);
lbState.Caption:='当前状态：PgUp , PgDn';
end;

//对调
procedure TForm1.N1Click(Sender: TObject);
begin
UnRegisterHotKey(handle,PgUpid);
RegisterHotKey(handle,PgUpid,0,VK_PRIOR);
UnRegisterHotKey(handle,PgDnid);
RegisterHotKey(handle,PgDnid,0,VK_NEXT);
IconData.hIcon:=img1.Picture.Icon.Handle;
Shell_NOtifyicon(NIM_MODIFY,@IconData);
lbState.Caption:='当前状态：Home , End';
end;


procedure TForm1.btHideClick(Sender: TObject);
begin
//Form1.WindowState:=wsMinimized;
Form1.hide;
end;

procedure TForm1.FormCloseQuery(Sender: TObject;
var CanClose: Boolean);
begin
{if closeflag=true then
CanClose:=true
else
begin
if Application.MessageBox('关闭 ？','提示',MB_OKCANCEL+MB_ICONINFORMATION)=IDOK then
begin
CanClose:=true;
end else
begin
Form1.hide;
CanClose:=False;
end;
end;
}
end;

procedure TForm1.FormKeyPress(Sender: TObject;
var Key: Char);
begin
//VK_ESCAPE=27
if Key=#27 then
Form1.Hide;
end;

end.