一个关于系统托盘的问题

http://www.hongen.com/pc/program/apitutor/api0012/api01.htm

又一个实现系统托盘图表的源码的例子,很简单的,down下来看看就明白了，这个问题被问过N次了:
http://www.8860.net/delphicode/dispdoc.asp?id=64

我只知道把应用程序放在下面
uses
    shellapi。；
  private
    { Private declarations }
    lpData:PNotifyIconData;    procedure WMSysCommand(var Message: TMessage); message WM_SYSCOMMAND;
    procedure WMBarIcon(var Message: TMessage) ;message WM_BARICON;
    function adoconnected(Sender: TObject):boolean;procedure Tjs_server.WMSysCommand(var Message: TMessage);begin
  if (Message.WParam =SC_MINIMIZE) or (Message.WParam =SC_CLOSE )   then
  begin
   lpData := new(PNotifyIconDataA);
   lpData.cbSize := 88;
   lpData.Wnd := self.Handle;
   lpData.hIcon := application.icon.Handle;
   lpData.uCallbackMessage := WM_BARICON;
   lpData.uID :=0;
   lpData.szTip := '¹ÜÀíÏµÍ³·þÎñÆ÷¶Ë';
   lpData.uFlags := NIF_ICON or NIF_MESSAGE or NIF_TIP;
   Shell_NotifyIcon(NIM_ADD,lpData);
   hide;
  end；end;
procedure Tjs_server.WMBarIcon(var Message: TMessage);
begin
{ if (Message.LParam = WM_LBUTTONDOWN) then
    begin
      if InputBox('µÇÂ¼', 'ÇëÊäÈë¿ÚÁî            ', '')<>'12345' then exit ;
     Shell_NotifyIcon(NIM_DELETE,lpData);
     dispose(lpData);
     show;
   end;}
    if (Message.LParam = WM_LBUTTONDOWN) then
     begin
       Shell_NotifyIcon(NIM_DELETE,lpData);
       dispose(lpData);
       show;
      end;
   if (Message.LParam = WM_RBUTTONDOWN) then
     begin
       PopupMenu1.Popup(Mouse.CursorPos.X,Mouse.CursorPos.Y);
      end;
end;程序上考下来的，自己加个PopupMenu1就可以象那样超做了

nit TrayBarIcon;interfaceuses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
  Menus, ShellApi, extctrls;const
  //自定义用户信息
  WM_TRAYNOTIFY = WM_USER + 1024;
  IconID = 1;type
  TCycleEvent = procedure(Sender: TObject; Current: Integer) of object;
  TMainFormMinimizeEvent = procedure(Sender: TObject; var GotoTray: Boolean) of object;  TTrayIcon = class(TComponent)
  private
    FEnabled: Boolean;
    FIcon: TIcon;
    FIconVisible: Boolean;
    FHint: String;
    FShowHint: Boolean;
    FPopupMenu: TPopupMenu;
    FLeftPopup: Boolean;
    FOnClick,
    FOnDblClick: TNotifyEvent;
    FOnCycle: TCycleEvent;
    FOnMouseDown,
    FOnMouseUp: TMouseEvent;
    FOnMouseMove: TMouseMoveEvent;
    FStartMinimized: Boolean;
    FMinimizeToTray: Boolean;
    HasShown: Boolean;
    FClicked: Boolean;
    CycleTimer: TTimer;           // 图标变换
    FDesignPreview: Boolean;
    SettingPreview: Boolean;
    FIconList: TImageList;
    FCycleIcons: Boolean;
    FCycleInterval: Cardinal;
    IconIndex: Integer;           // 当前图标索引
    OldAppProc, NewAppProc: Pointer;   // 过程变量
    procedure SetCycleIcons(Value: Boolean);
    procedure SetDesignPreview(Value: Boolean);
    procedure SetCycleInterval(Value: Cardinal);
    procedure TimerCycle(Sender: TObject);
    procedure HandleIconMessage(var Msg: TMessage);
    function InitIcon: Boolean;
    procedure SetIcon(Value: TIcon);
    procedure SetIconVisible(Value: Boolean);
    procedure SetHint(Value: String);
    procedure SetShowHint(Value: Boolean);
    procedure PopupAtCursor;
    procedure HookApp;
    procedure UnhookApp;
    procedure HookAppProc(var Message: TMessage);
  protected
    IconData: TNotifyIconData;    // 系统托盘图标的数据结构
    procedure Loaded; override;
    function ShowIcon: Boolean; virtual;
    function HideIcon: Boolean; virtual;
    function ModifyIcon: Boolean; virtual;
    procedure Click; dynamic;
    procedure DblClick; dynamic;
    procedure CycleIcon; dynamic;
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
      X, Y: Integer); dynamic;
    procedure MouseUp(Button: TMouseButton; Shift: TShiftState;
      X, Y: Integer); dynamic;
    procedure MouseMove(Shift: TShiftState; X, Y: Integer); dynamic;
    procedure DoMinimizeToTray; dynamic;
    procedure Notification(AComponent: TComponent; Operation: TOperation);
      override;
  public
    property Handle: HWND read IconData.wnd;
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure ShowMainForm;
    procedure HideMainForm;
    procedure Refresh;
  published
    // 属性操作:
    property DesignPreview: Boolean read FDesignPreview
      write SetDesignPreview default False;
    property IconList: TImageList read FIconList write FIconList;
    property CycleIcons: Boolean read FCycleIcons write SetCycleIcons
      default False;
    property CycleInterval: Cardinal read FCycleInterval
      write SetCycleInterval;
    property Enabled: Boolean read FEnabled write FEnabled default True;
    property Hint: String read FHint write SetHint;
    property ShowHint: Boolean read FShowHint write SetShowHint;
    property Icon: TIcon read FIcon write SetIcon stored True;
    property IconVisible: Boolean read FIconVisible write SetIconVisible
      default True;
    property PopupMenu: TPopupMenu read FPopupMenu write FPopupMenu;
    property LeftPopup: Boolean read FLeftPopup write FLeftPopup
      default False;
    property StartMinimized: Boolean read FStartMinimized write FStartMinimized
      default False;         // 程序开始运行时最小化?
    property MinimizeToTray: Boolean read FMinimizeToTray write FMinimizeToTray
      default False;         // 程序最小化时是否自动显示图标?
    // 方法:
    property OnClick: TNotifyEvent read FOnClick write FOnClick;
    property OnDblClick: TNotifyEvent read FOnDblClick write FOnDblClick;
    property OnMouseDown: TMouseEvent read FOnMouseDown write FOnMouseDown;
    property OnMouseUp: TMouseEvent read FOnMouseUp write FOnMouseUp;
    property OnMouseMove: TMouseMoveEvent read FOnMouseMove write FOnMouseMove;
    property OnCycle: TCycleEvent read FOnCycle write FOnCycle;
  end;procedure Register;implementationconstructor TTrayIcon.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FIconVisible := True;
  FEnabled := True;
  HasShown := False;
  SettingPreview := False;  FIcon := TIcon.Create;
  IconData.cbSize := SizeOf(TNotifyIconData);
  // 设置托盘图标回调函数
  IconData.wnd := AllocateHWnd(HandleIconMessage);
  // 设置图标ID
  IconData.uId := IconID;
  // 设置图标，消息句柄，提示
  IconData.uFlags := NIF_ICON + NIF_MESSAGE + NIF_TIP;
  // 当鼠标在图标上有动作时发出的消息
  IconData.uCallbackMessage := WM_TRAYNOTIFY;  CycleTimer := TTimer.Create(Self);
  CycleTimer.Enabled := False;
  CycleTimer.Interval := FCycleInterval;
  CycleTimer.OnTimer := TimerCycle;  if not (csDesigning in ComponentState) then
    HookApp;
end;

unit Unit1;interfaceuses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, Menus, shellapi;type
  TForm1 = class(TForm)
    PopupMenu1: TPopupMenu;
    Timer1: TTimer;
    open1: TMenuItem;
    exit1: TMenuItem;
    procedure FormCreate(Sender: TObject);
    procedure open1Click(Sender: TObject);
    procedure exit1Click(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure Timer1Timer(Sender: TObject);
  private
    procedure wndproc(var msg:tmessage);override;
    { Private declarations }
  public
    icondata:tnotifyicondata;
    iconcount:integer;
    { Public declarations }
  end;var
  Form1: TForm1;implementation{$R *.dfm}procedure tform1.wndproc(var msg:tmessage);
var
  p:tpoint;
begin
  case msg.msg of
  wm_user+1:
    case msg.LParam  of
      wm_rbuttondown:
        begin
         getcursorpos(p);
         popupmenu1.Popup(p.X,p.Y);
        end;
      WM_LBUTTONDBLCLK:
        begin
          form1.Show;
          showwindow(application.Handle ,sw_hide);
        end;
    end;
  end;
  inherited;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
  bordericons:=[bisystemmenu];
  iconcount:=0;
  icondata.cbSize :=sizeof(icondata);
  icondata.Wnd :=handle;
  icondata.uID:=100;
  icondata.uFlags :=nif_message+nif_icon+nif_tip;
  icondata.uCallbackMessage :=wm_user+1;
  icondata.hIcon :=application.Icon.Handle ;
  strpcopy(icondata.szTip,application.Title );
  shell_notifyicon(nim_add,@icondata);
  timer1.Interval :=1000;
  timer1.Enabled :=true;
end;procedure TForm1.open1Click(Sender: TObject);
begin
  form1.Show;
  showwindow(application.Handle ,sw_hide);
end;procedure TForm1.exit1Click(Sender: TObject);
begin
  shell_notifyicon(nim_delete,@icondata);
  application.ProcessMessages ;
  application.Terminate ;
end;procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  action:=canone;
  form1.Hide ;
end;procedure TForm1.Timer1Timer(Sender: TObject);
begin
  case (iconcount) of
    0: icondata.hIcon :=loadicon(0, idi_application);
    1: icondata.hIcon :=loadicon(0, idi_asterisk);
    2: icondata.hIcon :=loadicon(0, idi_exclamation);
    3: icondata.hIcon :=loadicon(0, idi_hand);
    4: icondata.hIcon :=loadicon(0, idi_question);
    5: icondata.hIcon :=application.Icon.Handle ;
  end;
  inc(iconcount);
  if iconcount>5 then
    iconcount:=0;
  application.Title :=timetostr(now);
  strpcopy(icondata.szTip ,application.Title );
  shell_notifyicon(nim_modify,@icondata);
end;end.

调试易

一个关于系统托盘的问题

解决方案 »