请高手:指点!托盘区的图标为何不能响应鼠标的消息???

lql6288110 2002-03-22 02:53:25
unit Unit1;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,ShellApi,
StdCtrls, Buttons, Menus;

type
TForm1 = class(TForm)
BitBtn1: TBitBtn;
pop1: TPopupMenu;
Y1: TMenuItem;
N1: TMenuItem;
x1: TMenuItem;
BitBtn2: TBitBtn;
procedure InstallIcon;
procedure IconOnClick;
procedure BitBtn1Click(Sender: TObject);
procedure WMTrayNotify(var Msg:TMessage);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;
implementation

{$R *.DFM}

procedure TForm1.InstallIcon; //把一图标放在托盘区 ----已实现!
var
IconData: TNotifyIconData;
CdRomIcon:Ticon;
begin
CdRomIcon := TIcon.Create;
CdRomIcon.LoadFromFile( 'c:\1.ico' );
IconData.cbSize := SizeOf( IconData );
IconData.Wnd := Handle;
IconData.uID := 1;
IconData.uFlags := NIF_ICON
or NIF_MESSAGE or NIF_TIP;
IconData.uCallBackMessage := WM_USER+1;
IconData.hIcon := CdRomIcon.Handle;
IconData.szTip := 'SOCKET应用服务器';
Shell_NotifyIcon( NIM_ADD, @IconData );
end;

procedure TForm1.BitBtn1Click(Sender: TObject); //一按键调用上述过程
begin
InstallIcon;
end;


procedure TForm1.IconOnClick; //托盘区的图标响应过程 ----- 图标不能响应这个过程???
var
p : TPoint;
message: Tmessage;
begin
if (message.lParam = WM_LBUTTONDOWN) then
ShowWindow(Handle, SW_SHOW );
if (message.lParam = WM_RBUTTONDOWN) then
begin
GetCursorPos(p);
pop1.Popup( p.x ,p.y ); //pop1为在主窗口中定义的弹出式菜单
end;
end;

//*********************************
procedure TForm1.WMTrayNotify(var Msg:TMessage);
const
WM_TRAYNOTIFY=$4444; // 自定义消息;
MY_TRAY_ICON=$4532; // 自定义消息;
var
NT:TNotifyIconData;
begin
if (Msg.LParam <>WM_LBUTTONDBLCLK) then exit;
with NT do
begin
cbSize:=SizeOf(TNotifyIconData);
Wnd:=Handle;
UID:=MY_TRAY_ICON;
uFlags:=NIF_MESSAGE or NIF_ICON or NIF_TIP;
uCallBackMessage:=WM_TRAYNOTIFY;
szTip:=#0;
end;
Shell_NotifyIcon(NIM_DELETE,@NT);
ShowWindow(Application.Handle,SW_SHOW);
Application.Restore;
end;

end.
...全文
76 3 打赏 收藏 转发到动态 举报
写回复
用AI写文章
3 条回复
切换为时间正序
请发表友善的回复…
发表回复
Bellamy 2002-03-22
  • 打赏
  • 举报
回复
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
......
taber 2002-03-22
  • 打赏
  • 举报
回复
重定义IconOnClick:
procedure IconClick(var Msg: TMessage); Message WM_BARICON;
深宇 2002-03-22
  • 打赏
  • 举报
回复
看看下面的代码对你有没有帮助
unit Unit1;

interface

uses
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.

830

社区成员

发帖
与我相关
我的任务
社区描述
Delphi 非技术区
社区管理员
  • 非技术区社区
加入社区
  • 近7日
  • 近30日
  • 至今
社区公告
暂无公告

试试用AI创作助手写篇文章吧