请高手：指点！托盘区的图标为何不能响应鼠标的消息？？？

看看下面的代码对你有没有帮助
unit Unit1;interfaceuses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  Menus, ActnList, StdActns, Db,registry, DBTables,shellapi,extctrls,dbctrls,grids,dbgrids,stdctrls,
  oleserver,word97,clipbrd;const
  WM_BARICON=3000;type
  TForm1 = class(TForm)
    Edit1: TEdit;
    Label1: TLabel;
    Button1: TButton;
    Memo1: TMemo;
    Label2: TLabel;
    Edit2: TEdit;
    Label3: TLabel;
    Memo2: TMemo;
    Label4: TLabel;
    Edit3: TEdit;
    Button2: TButton;
    OpenDialog1: TOpenDialog;
    Edit4: TEdit;
    Label6: TLabel;
    Edit5: TEdit;
    CheckBox1: TCheckBox;
    Timer1: TTimer;
    ActionList1: TActionList;
    minwindow: TAction;
    PopupMenu1: TPopupMenu;
    N1: TMenuItem;
    Label5: TLabel;
    Button3: TButton;
    procedure Button2Click(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure minwindowExecute(Sender: TObject);
    procedure N1Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);  private
  procedure WMBarIcon(var Message:TMessage); message WM_BARICON;
  procedure WMSysCommand(var Message: TMessage); message WM_SYSCOMMAND;
  procedure ShutdownWin(Flags : Word);
    { Private declarations }
  public
    { Public declarations }
  end;var
  Form1: TForm1;
  strtime,closestr,currpath:string;
  ifstart:integer=0;implementation{$R *.DFM}
uses
  unit2;procedure TForm1.Button2Click(Sender: TObject);
var
  i:integer;
  Reg: TRegistry;
begin
  memo1.Lines.Text:='';
  memo1.lines.add('set wshshell=createobject("wscript.shell")');
  memo1.lines.add('wshshell.run"'+edit1.text+'"');
  memo1.lines.add('wscript.sleep '+inttostr(strtoint(edit2.text)*1000));
  for i:=0 to memo1.Lines.Count-1 do
    begin
      if memo2.lines.strings[i]<>'' then
        begin
          memo1.lines.add('wshshell.sendkeys"'+memo2.Lines.Strings[i]+'"');
          memo1.Lines.Add('wscript.sleep '+inttostr(strtoint(edit3.text)*1000));
        end;
    end;
  memo1.Lines.SaveToFile(currpath+'1.vbs');
  Reg := TRegistry.Create;
    if checkbox1.Checked then
      begin
        Reg.RootKey := HKEY_CURRENT_USER;
        if Reg.OpenKey('\SOFTWARE\Microsoft\Windows\CurrentVersion\Run', True)then
           Reg.WriteString('autostart','"' + paramstr(0) + '"');
      end
    else
      begin
        Reg.RootKey := HKEY_CURRENT_USER;
        if Reg.OpenKey('\SOFTWARE\Microsoft\Windows\CurrentVersion\Run', True)then
           Reg.deletevalue('autostart');
      end;
  memo1.Lines.Text:='';
  memo1.Lines.add(edit4.Text);
  memo1.lines.SaveToFile(currpath+'1.txt');
  memo1.lines.text:='';
  memo1.lines.Add(edit5.text);
  memo1.lines.savetofile(currpath+'2.txt');
end;procedure TForm1.Button1Click(Sender: TObject);
begin
   if opendialog1.Execute then
     edit1.text:=opendialog1.FileName ;
end;procedure TForm1.FormShow(Sender: TObject);
begin
  currpath:=extractfilepath(application.ExeName);
  if fileexists('1.txt') then
  begin
    memo1.lines.text:='';
    memo1.Lines.LoadFromFile(currpath+'1.txt');
    strtime:=trim(memo1.lines.text);
  end;
  if fileexists('2.txt') then
  begin
    memo1.lines.Text:='';
    memo1.lines.loadfromfile(currpath+'2.txt');
    closestr:=trim(memo1.lines.text);
  end;
// else
   // closestr:=timetostr(time());
  memo1.lines.Text:='';
  ShowWindow(Application.Handle, SW_HIDE);
end;procedure TForm1.Timer1Timer(Sender: TObject);
begin
  if timetostr(time())=strtime then
    shellexecute(1,'open','1.vbs','null',pchar(currpath),5);
  if ifstart=1 then
     minwindowExecute(self);
  ifstart:=ifstart+1;
  if timetostr(time())=closestr then
     shutdownwin(1);
end;procedure TForm1.minwindowExecute(Sender: TObject);
var
  IconData: TNotifyIconData;
begin
  iconData.cbSize := sizeof(icondata);
  iconData.Wnd := Handle;
  IconData.uID := 1;
  IconData.uFlags := NIF_ICON or NIF_MESSAGE or NIF_TIP;
  IconData.uCallBackMessage :=WM_BARICON;
  IconData.hIcon := form1.icon.Handle;
  IconData.szTip := 'autostart';
  Shell_NotifyIcon( NIM_ADD, @IconData );
  form1.visible:=false;
end;procedure Tform1.WMBarIcon(var Message:TMessage);
var
  lpData:PNotifyIconData;
  p:tpoint;
begin
  if (Message.LParam = WM_LBUTTONDOWN) then
    begin    //如果用户点击任务栏图标则将图标删除并回复窗口。
      lpData := new(PNotifyIconDataA);
      lpData.cbSize :=SizeOf(PNotifyIconDataA);
      lpData.Wnd := form1.Handle;
      lpData.hIcon := form1.Icon.Handle;
      lpData.uCallbackMessage := WM_BARICON;
      lpData.uID :=0;
      lpData.szTip := 'autostart';
      lpData.uFlags := NIF_ICON or NIF_MESSAGE or NIF_TIP;
      Shell_NotifyIcon(NIM_DELETE,lpData);
      dispose(lpData);
      form1.Visible := True;
      ShowWindow(Application.Handle, SW_SHOW);
    end
  else
    if (Message.LParam = WM_RBUTTONDOWN) then
      begin
        GetCursorPos(p); //获取光标位置
       // pmTray.Popup(p.x,p.y);  //显示弹出菜单
       popupmenu1.Popup(p.x,p.y);
      end;
end;procedure Tform1.WMSysCommand(var Message:TMessage);
begin
// if query1.FieldByName('automin').value then
    if Message.WParam = SC_ICON then
      begin    //如果用户最小化窗口则将窗口    隐藏并在任务栏上添加图标
        ShowWindow(Application.Handle, SW_HIDE);
        minwindowExecute(self);
      end
    else
      begin    //如果是其它的SystemCommand消息则调用系统缺省处理函数处理之。
        DefWindowProc(form1.Handle,Message.Msg,Message.WParam,Message.LParam);
     end;
end;procedure TForm1.N1Click(Sender: TObject);
begin
  close;
end;procedure tform1.ShutdownWin(Flags : Word);
var
  hToken : THandle;
  tkp, ptkp : TTokenPrivileges;
  i : DWORD;
begin
  OpenProcessToken(GetCurrentProcess, TOKEN_ADJUST_PRIVILEGES + TOKEN_QUERY, hToken);
  LookupPrivilegeValue(nil, PChar('SeShutdownPrivilege'), tkp.Privileges[0].Luid);
  tkp.PrivilegeCount := 1;
  tkp.Privileges[0].Attributes := SE_PRIVILEGE_ENABLED;
  AdjustTokenPrivileges(hToken, False, tkp, SizeOf(tkp), ptkp, i);
  GetLastError;
  ExitWindowsEx(EWX_FORCE or Flags, 0);
end;procedure TForm1.Button3Click(Sender: TObject);
begin
  form2.ShowModal ;
end;end.

解决方案 »

免费领取超大流量手机卡，每月29元包185G流量+100分钟通话, 中国电信官方发货

重定义IconOnClick:
  procedure IconClick(var Msg: TMessage); Message WM_BARICON;
procedure TControlE.PopMenu(var PopMsg:TMessage);var  PopUpMenu:TBcBarPopupMenu;  //弹出的窗口  SubItem:array[1..10] of TMenuItem;  //弹出式窗口的两个子项  PosXY:TPoint;  //弹出式窗口的位置  i:integer;begin     if PopMsg.LParam=WM_RBUTTONDOWN  //如果是鼠标右键按下     then begin
     ......