把你的程序显示在托盘区

托盘区就是在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.

你可能感兴趣的:(windows,UP)