托盘区就是在windows的状态栏下方显示时钟、输入法状态的地方, 要把你的程序显示在托盘区: 下面是一个托盘类,只要把下面粘贴到文本文件中,改成TrayIcon.pas,使用时uses TrayIcon就可以了。 先声明一个全局变量: var tray:TTrayNotifyIcon; 然后在窗体的OnCreate事件中: tray:=TTrayNotifyIcon.Create(self);//将窗体创建为托盘 tray.Icon:=application.Icon;//定义托盘的显示图标 tray.IconVisible:=true;//托盘可见 tray.PopupMenu:=popmenu;//给托盘定义一个右击时的弹出菜单 tray.OnDblClick:=trayDblClick;//给托盘定义一个双击事件(当然要自己写了,不过多数情况只有一行,就是Form1.show); unit TrayIcon; interface uses Windows, SysUtils, Messages, ShellAPI, Classes, Graphics, Forms, Menus, StdCtrls, ExtCtrls; type ENotifyIconError = class(Exception); TTrayNotifyIcon = class(TComponent) private FDefaultIcon: THandle; FIcon: TIcon; FHideTask: Boolean; FHint: string; FIconVisible: Boolean; FPopupMenu: TPopupMenu; FOnClick: TNotifyEvent; FOnDblClick: TNotifyEvent; FNoShowClick: Boolean; FTimer: TTimer; Tnd: TNotifyIconData; procedure SetIcon(Value: TIcon); procedure SetHideTask(Value: Boolean); procedure SetHint(Value: string); procedure SetIconVisible(Value: Boolean); procedure SetPopupMenu(Value: TPopupMenu); procedure SendTrayMessage(Msg: DWORD; Flags: UINT); function ActiveIconHandle: THandle; procedure OnButtonTimer(Sender: TObject); protected procedure Loaded; override; procedure LoadDefaultIcon; virtual; procedure Notification(AComponent: TComponent; Operation: TOperation); override; public constructor Create(AOwner: TComponent); override; destructor Destroy; override; published property Icon: TIcon read FIcon write SetIcon; property HideTask: Boolean read FHideTask write SetHideTask default False; property Hint: String read FHint write SetHint; property IconVisible: Boolean read FIconVisible write SetIconVisible default False; property PopupMenu: TPopupMenu read FPopupMenu write SetPopupMenu; property OnClick: TNotifyEvent read FOnClick write FOnClick; property OnDblClick: TNotifyEvent read FOnDblClick write FOnDblClick; end; implementation { TIconManager } { This class creates a hidden window which handles and routes } { tray icon messages } type TIconManager = class private FHWindow: HWnd; procedure TrayWndProc(var Message: TMessage); public constructor Create; destructor Destroy; override; property HWindow: HWnd read FHWindow write FHWindow; end; var IconMgr: TIconManager; DDGM_TRAYICON: Cardinal; constructor TIconManager.Create; begin FHWindow := AllocateHWnd(TrayWndProc); end; destructor TIconManager.Destroy; begin if FHWindow <> 0 then DeallocateHWnd(FHWindow); inherited Destroy; end; procedure TIconManager.TrayWndProc(var Message: TMessage); { This allows us to handle all tray callback messages } { from within the context of the component. } var Pt: TPoint; TheIcon: TTrayNotifyIcon; begin with Message do begin { if it’s the tray callback message } if (Msg = DDGM_TRAYICON) then begin TheIcon := TTrayNotifyIcon(WParam); case lParam of { enable timer on first mouse down. } { OnClick will be fired by OnTimer method, provided } { double click has not occurred. } WM_LBUTTONDOWN: TheIcon.FTimer.Enabled := True; { Set no click flag on double click. This will supress } { the single click. } WM_LBUTTONDBLCLK: begin TheIcon.FNoShowClick := True; if Assigned(TheIcon.FOnDblClick) then TheIcon.FOnDblClick(Self); end; WM_RBUTTONDOWN: begin if Assigned(TheIcon.FPopupMenu) then begin { Call to SetForegroundWindow is required by API } SetForegroundWindow(IconMgr.HWindow); { Popup local menu at the cursor position. } GetCursorPos(Pt); TheIcon.FPopupMenu.Popup(Pt.X, Pt.Y); { Message post required by API to force task switch } PostMessage(IconMgr.HWindow, WM_USER, 0, 0); end; end; end; end else { If it isn’t a tray callback message, then call DefWindowProc } Result := DefWindowProc(FHWindow, Msg, wParam, lParam); end; end; { TTrayNotifyIcon } constructor TTrayNotifyIcon.Create(AOwner: TComponent); begin inherited Create(AOwner); FIcon := TIcon.Create; FTimer := TTimer.Create(Self); with FTimer do begin Enabled := False; Interval := GetDoubleClickTime; OnTimer := OnButtonTimer; end; { Keep default windows icon handy... } LoadDefaultIcon; end; destructor TTrayNotifyIcon.Destroy; begin if FIconVisible then SetIconVisible(False); // destroy icon FIcon.Free; // free stuff FTimer.Free; inherited Destroy; end; function TTrayNotifyIcon.ActiveIconHandle: THandle; { Returns handle of active icon } begin { If no icon is loaded, then return default icon } if (FIcon.Handle <> 0) then Result := FIcon.Handle else Result := FDefaultIcon; end; procedure TTrayNotifyIcon.LoadDefaultIcon; { Loads default window icon to keep it handy. } { This will allow the component to use the windows logo } { icon as the default when no icon is selected in the } { Icon property. } begin FDefaultIcon := LoadIcon(0, IDI_WINLOGO); end; procedure TTrayNotifyIcon.Loaded; { Called after component is loaded from stream } begin inherited Loaded; { if icon is supposed to be visible, create it. } if FIconVisible then SendTrayMessage(NIM_ADD, NIF_MESSAGE or NIF_ICON or NIF_TIP); end; procedure TTrayNotifyIcon.Notification(AComponent: TComponent; Operation: TOperation); begin inherited Notification(AComponent, Operation); if (Operation = opRemove) and (AComponent = PopupMenu) then PopupMenu := nil; end; procedure TTrayNotifyIcon.OnButtonTimer(Sender: TObject); { Timer used to keep track of time between two clicks of a } { double click. This delays the first click long enough to } { ensure that a double click hasn’t occurred. The whole } { point of these gymnastics is to allow the component to } { receive OnClicks and OnDblClicks independently. } begin { Disable timer because we only want it to fire once. } FTimer.Enabled := False; { if double click has not occurred, then fire single click. } if (not FNoShowClick) and Assigned(FOnClick) then FOnClick(Self); FNoShowClick := False; // reset flag end; procedure TTrayNotifyIcon.SendTrayMessage(Msg: DWORD; Flags: UINT); { This method wraps up the call to the API’s Shell_NotifyIcon } begin { Fill up record with appropriate values } with Tnd do begin cbSize := SizeOf(Tnd); StrPLCopy(szTip, PChar(FHint), SizeOf(szTip)); uFlags := Flags; uID := UINT(Self); Wnd := IconMgr.HWindow; uCallbackMessage := DDGM_TRAYICON; hIcon := ActiveIconHandle; end; Shell_NotifyIcon(Msg, @Tnd); end; procedure TTrayNotifyIcon.SetHideTask(Value: Boolean); { Write method for HideTask property } const { Flags to show application normally or hide it } ShowArray: array[Boolean] of integer = (sw_ShowNormal, sw_Hide); begin if FHideTask <> Value then begin FHideTask := Value; { Don’t do anything in design mode } if not (csDesigning in ComponentState) then ShowWindow(Application.Handle, ShowArray[FHideTask]); end; end; procedure TTrayNotifyIcon.SetHint(Value: string); { Set method for Hint property } begin if FHint <> Value then begin FHint := Value; if FIconVisible then { Change hint on icon on tray notification area } SendTrayMessage(NIM_MODIFY, NIF_TIP); end; end; procedure TTrayNotifyIcon.SetIcon(Value: TIcon); { Write method for Icon property. } begin FIcon.Assign(Value); // set new icon { Change icon on notification tray } if FIconVisible then SendTrayMessage(NIM_MODIFY, NIF_ICON); end; procedure TTrayNotifyIcon.SetIconVisible(Value: Boolean); { Write method for IconVisible property } const { Flags to add or delete a tray notification icon } MsgArray: array[Boolean] of DWORD = (NIM_DELETE, NIM_ADD); begin if FIconVisible <> Value then begin FIconVisible := Value; { Set icon as appropriate } SendTrayMessage(MsgArray[Value], NIF_MESSAGE or NIF_ICON or NIF_TIP); end; end; procedure TTrayNotifyIcon.SetPopupMenu(Value: TPopupMenu); { Write method for PopupMenu property } begin FPopupMenu := Value; if Value <> nil then Value.FreeNotification(Self); end; const { String to identify registered window message } TrayMsgStr = ’DDG.TrayNotifyIconMsg’; initialization { Get a unique windows message ID for tray callback } DDGM_TRAYICON := RegisterWindowMessage(TrayMsgStr); IconMgr := TIconManager.Create; finalization IconMgr.Free; end.
procedure TForm1.Button1Click(Sender: TObject); begin form1.Width := 80; form1.Height := 30; dx := (screen.Width - form1.Left - form1.Width) div 10; dy := (screen.Height - form1.Height - form1.Top) div 10; Timer1.Enabled := true; end;procedure TForm1.Timer1Timer(Sender: TObject); begin if form1.Top < screen.Height then begin form1.Left := form1.Left + dx; form1.Top := form1.Top + dx; form1.Width := form1.Width - 4; end else begin timer1.Enabled := false; form1.Close ; end; end;
设置Timer1.Interval := 20;
安裝一下動畫TransEff組件,然後拖以下幾個組件,寫以下代碼,F9看效果: FormTransitions1: TFormTransitions; TransitionList1: TTransitionList; Transition1: TRollTransition; 1.form create時: Randomize; FormTransitions1.ShowTransition:=TransitionList1.Transitions[Random(1)]; 2.FormCloseQuery時:procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean); begin FormTransitions1.HideTransition:=TransitionList1.Transitions[Random(1)]; end;
AnimateWindow(Handle, 600, AW_BLEND or AW_ACTIVATE);//
to mysterx: 我试过用Timer的方法, 虽然思路简单易懂,但是效果还是比较粗糙啊 跟QQ比起来有些差距to kye_jufei: 不知道你说的TransEff組件哪里有呢, 能否提供一下,谢谢
要把你的程序显示在托盘区:
下面是一个托盘类,只要把下面粘贴到文本文件中,改成TrayIcon.pas,使用时uses TrayIcon就可以了。
先声明一个全局变量:
var tray:TTrayNotifyIcon;
然后在窗体的OnCreate事件中:
tray:=TTrayNotifyIcon.Create(self);//将窗体创建为托盘
tray.Icon:=application.Icon;//定义托盘的显示图标
tray.IconVisible:=true;//托盘可见
tray.PopupMenu:=popmenu;//给托盘定义一个右击时的弹出菜单
tray.OnDblClick:=trayDblClick;//给托盘定义一个双击事件(当然要自己写了,不过多数情况只有一行,就是Form1.show);
unit TrayIcon;
interface
uses Windows, SysUtils, Messages, ShellAPI, Classes, Graphics, Forms, Menus,
StdCtrls, ExtCtrls;
type
ENotifyIconError = class(Exception);
TTrayNotifyIcon = class(TComponent)
private
FDefaultIcon: THandle;
FIcon: TIcon;
FHideTask: Boolean;
FHint: string;
FIconVisible: Boolean;
FPopupMenu: TPopupMenu;
FOnClick: TNotifyEvent;
FOnDblClick: TNotifyEvent;
FNoShowClick: Boolean;
FTimer: TTimer;
Tnd: TNotifyIconData;
procedure SetIcon(Value: TIcon);
procedure SetHideTask(Value: Boolean);
procedure SetHint(Value: string);
procedure SetIconVisible(Value: Boolean);
procedure SetPopupMenu(Value: TPopupMenu);
procedure SendTrayMessage(Msg: DWORD; Flags: UINT);
function ActiveIconHandle: THandle;
procedure OnButtonTimer(Sender: TObject);
protected
procedure Loaded; override;
procedure LoadDefaultIcon; virtual;
procedure Notification(AComponent: TComponent;
Operation: TOperation); override;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
published
property Icon: TIcon read FIcon write SetIcon;
property HideTask: Boolean read FHideTask write SetHideTask default False;
property Hint: String read FHint write SetHint;
property IconVisible: Boolean read FIconVisible write SetIconVisible default False;
property PopupMenu: TPopupMenu read FPopupMenu write SetPopupMenu;
property OnClick: TNotifyEvent read FOnClick write FOnClick;
property OnDblClick: TNotifyEvent read FOnDblClick write FOnDblClick;
end;
implementation
{ TIconManager }
{ This class creates a hidden window which handles and routes }
{ tray icon messages }
type
TIconManager = class
private
FHWindow: HWnd;
procedure TrayWndProc(var Message: TMessage);
public
constructor Create;
destructor Destroy; override;
property HWindow: HWnd read FHWindow write FHWindow;
end;
var
IconMgr: TIconManager;
DDGM_TRAYICON: Cardinal;
constructor TIconManager.Create;
begin
FHWindow := AllocateHWnd(TrayWndProc);
end;
destructor TIconManager.Destroy;
begin
if FHWindow <> 0 then DeallocateHWnd(FHWindow);
inherited Destroy;
end;
procedure TIconManager.TrayWndProc(var Message: TMessage);
{ This allows us to handle all tray callback messages }
{ from within the context of the component. }
var
Pt: TPoint;
TheIcon: TTrayNotifyIcon;
begin
with Message do
begin
{ if it’s the tray callback message }
if (Msg = DDGM_TRAYICON) then
begin
TheIcon := TTrayNotifyIcon(WParam);
case lParam of
{ enable timer on first mouse down. }
{ OnClick will be fired by OnTimer method, provided }
{ double click has not occurred. }
WM_LBUTTONDOWN: TheIcon.FTimer.Enabled := True;
{ Set no click flag on double click. This will supress }
{ the single click. }
WM_LBUTTONDBLCLK:
begin
TheIcon.FNoShowClick := True;
if Assigned(TheIcon.FOnDblClick) then TheIcon.FOnDblClick(Self);
end;
WM_RBUTTONDOWN:
begin
if Assigned(TheIcon.FPopupMenu) then
begin
{ Call to SetForegroundWindow is required by API }
SetForegroundWindow(IconMgr.HWindow);
{ Popup local menu at the cursor position. }
GetCursorPos(Pt);
TheIcon.FPopupMenu.Popup(Pt.X, Pt.Y);
{ Message post required by API to force task switch }
PostMessage(IconMgr.HWindow, WM_USER, 0, 0);
end;
end;
end;
end
else
{ If it isn’t a tray callback message, then call DefWindowProc }
Result := DefWindowProc(FHWindow, Msg, wParam, lParam);
end;
end;
{ TTrayNotifyIcon }
constructor TTrayNotifyIcon.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FIcon := TIcon.Create;
FTimer := TTimer.Create(Self);
with FTimer do
begin
Enabled := False;
Interval := GetDoubleClickTime;
OnTimer := OnButtonTimer;
end;
{ Keep default windows icon handy... }
LoadDefaultIcon;
end;
destructor TTrayNotifyIcon.Destroy;
begin
if FIconVisible then SetIconVisible(False); // destroy icon
FIcon.Free; // free stuff
FTimer.Free;
inherited Destroy;
end;
function TTrayNotifyIcon.ActiveIconHandle: THandle;
{ Returns handle of active icon }
begin
{ If no icon is loaded, then return default icon }
if (FIcon.Handle <> 0) then
Result := FIcon.Handle
else
Result := FDefaultIcon;
end;
procedure TTrayNotifyIcon.LoadDefaultIcon;
{ Loads default window icon to keep it handy. }
{ This will allow the component to use the windows logo }
{ icon as the default when no icon is selected in the }
{ Icon property. }
begin
FDefaultIcon := LoadIcon(0, IDI_WINLOGO);
end;
procedure TTrayNotifyIcon.Loaded;
{ Called after component is loaded from stream }
begin
inherited Loaded;
{ if icon is supposed to be visible, create it. }
if FIconVisible then
SendTrayMessage(NIM_ADD, NIF_MESSAGE or NIF_ICON or NIF_TIP);
end;
procedure TTrayNotifyIcon.Notification(AComponent: TComponent;
Operation: TOperation);
begin
inherited Notification(AComponent, Operation);
if (Operation = opRemove) and (AComponent = PopupMenu) then
PopupMenu := nil;
end;
procedure TTrayNotifyIcon.OnButtonTimer(Sender: TObject);
{ Timer used to keep track of time between two clicks of a }
{ double click. This delays the first click long enough to }
{ ensure that a double click hasn’t occurred. The whole }
{ point of these gymnastics is to allow the component to }
{ receive OnClicks and OnDblClicks independently. }
begin
{ Disable timer because we only want it to fire once. }
FTimer.Enabled := False;
{ if double click has not occurred, then fire single click. }
if (not FNoShowClick) and Assigned(FOnClick) then
FOnClick(Self);
FNoShowClick := False; // reset flag
end;
procedure TTrayNotifyIcon.SendTrayMessage(Msg: DWORD; Flags: UINT);
{ This method wraps up the call to the API’s Shell_NotifyIcon }
begin
{ Fill up record with appropriate values }
with Tnd do
begin
cbSize := SizeOf(Tnd);
StrPLCopy(szTip, PChar(FHint), SizeOf(szTip));
uFlags := Flags;
uID := UINT(Self);
Wnd := IconMgr.HWindow;
uCallbackMessage := DDGM_TRAYICON;
hIcon := ActiveIconHandle;
end;
Shell_NotifyIcon(Msg, @Tnd);
end;
procedure TTrayNotifyIcon.SetHideTask(Value: Boolean);
{ Write method for HideTask property }
const
{ Flags to show application normally or hide it }
ShowArray: array[Boolean] of integer = (sw_ShowNormal, sw_Hide);
begin
if FHideTask <> Value then
begin
FHideTask := Value;
{ Don’t do anything in design mode }
if not (csDesigning in ComponentState) then
ShowWindow(Application.Handle, ShowArray[FHideTask]);
end;
end;
procedure TTrayNotifyIcon.SetHint(Value: string);
{ Set method for Hint property }
begin
if FHint <> Value then
begin
FHint := Value;
if FIconVisible then
{ Change hint on icon on tray notification area }
SendTrayMessage(NIM_MODIFY, NIF_TIP);
end;
end;
procedure TTrayNotifyIcon.SetIcon(Value: TIcon);
{ Write method for Icon property. }
begin
FIcon.Assign(Value); // set new icon
{ Change icon on notification tray }
if FIconVisible then SendTrayMessage(NIM_MODIFY, NIF_ICON);
end;
procedure TTrayNotifyIcon.SetIconVisible(Value: Boolean);
{ Write method for IconVisible property }
const
{ Flags to add or delete a tray notification icon }
MsgArray: array[Boolean] of DWORD = (NIM_DELETE, NIM_ADD);
begin
if FIconVisible <> Value then
begin
FIconVisible := Value;
{ Set icon as appropriate }
SendTrayMessage(MsgArray[Value], NIF_MESSAGE or NIF_ICON or NIF_TIP);
end;
end;
procedure TTrayNotifyIcon.SetPopupMenu(Value: TPopupMenu);
{ Write method for PopupMenu property }
begin
FPopupMenu := Value;
if Value <> nil then Value.FreeNotification(Self);
end;
const
{ String to identify registered window message }
TrayMsgStr = ’DDG.TrayNotifyIconMsg’;
initialization
{ Get a unique windows message ID for tray callback }
DDGM_TRAYICON := RegisterWindowMessage(TrayMsgStr);
IconMgr := TIconManager.Create;
finalization
IconMgr.Free;
end.
procedure TForm1.Button1Click(Sender: TObject);
begin
form1.Width := 80;
form1.Height := 30;
dx := (screen.Width - form1.Left - form1.Width) div 10;
dy := (screen.Height - form1.Height - form1.Top) div 10;
Timer1.Enabled := true;
end;procedure TForm1.Timer1Timer(Sender: TObject);
begin
if form1.Top < screen.Height then
begin
form1.Left := form1.Left + dx;
form1.Top := form1.Top + dx;
form1.Width := form1.Width - 4;
end
else
begin
timer1.Enabled := false;
form1.Close ;
end;
end;
TransitionList1: TTransitionList;
Transition1: TRollTransition;
1.form create時: Randomize;
FormTransitions1.ShowTransition:=TransitionList1.Transitions[Random(1)];
2.FormCloseQuery時:procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
FormTransitions1.HideTransition:=TransitionList1.Transitions[Random(1)];
end;
我试过用Timer的方法,
虽然思路简单易懂,但是效果还是比较粗糙啊
跟QQ比起来有些差距to kye_jufei:
不知道你说的TransEff組件哪里有呢,
能否提供一下,谢谢
{
// 功能:在显示窗体动画效果前,先寻找系统区位置
TCHAR szClassName[256];
GetClassName(hwnd, szClassName, 255); // 比较窗口类名
if (strcmp(szClassName, "TrayNotifyWnd") == 0)
{
TRect *WRect= (TRect*) lParam;
::GetWindowRect(hwnd, WRect);
return TRUE;
} // 当找到时钟窗口时表示可以结束了
if (strcmp(szClassName, "TrayClockWClass") == 0)
{
TRect *pRect = (TRect*) lParam;
TRect rectClock;
::GetWindowRect(hwnd, &rectClock);
pRect->right = rectClock.left;
return FALSE;
} return TRUE;
}
//---------------------------------------------------------------------------
void __fastcall WinAnimation(HWND FrmHandle,bool ShowFlag)
{
//TODO:显示窗口动画效果的涵数
TRect rect(0,0,0,0); // 查找托盘窗口
HWND pWnd = FindWindow("Shell_TrayWnd", NULL);
if (pWnd)
{
GetWindowRect(pWnd,&rect);
EnumChildWindows(pWnd, (WNDENUMPROC)FindTrayWnd, (LPARAM)&rect);
//rect 为托盘区矩形
TRect rcWnd;
GetWindowRect(FrmHandle,&rcWnd);
if(ShowFlag) //窗体滑向系统区
DrawAnimatedRects(FrmHandle,IDANI_CAPTION,&rcWnd,&rect);
else //窗体从系统区滑出
DrawAnimatedRects(FrmHandle,IDANI_CAPTION,&rect,&rcWnd);
}
}
//---------------------------------------------------------------------------