任
任远
Unregistered / Unconfirmed
GUEST, unregistred user!
程序为单一DPR文件,运行后,在托盘区添加一图标,单击左键会弹出一个窗口,程序能编译通过,运行后能添加图标,但不能响应鼠标点击事件,查看进程无程序运行,应该是程序运行后自动退出,该如何才能让程序长驻内存?
源码如下============================
program MyDesk;
uses
Windows, Messages, Graphics, SysUtils, Dialogs, shellapi,
ExtCtrls, Menus, StrUtils, registry, ExtDlgs, Controls, Classes;
const
MY_MESSAGE = WM_USER + 100
//捕获托盘区鼠标点击事件
{$R *.res}
type
TCommon = class
function GetCurDir: string;
procedure ExitItemClick(Sender: TObject);
procedure SetStartUPClick(Sender: TObject);
procedure CreateMenu;
procedure CreateTimer;
private
{ Private declarations }
procedure OnIconNotify(var Message: TMessage);
message MY_MESSAGE;
public
{ Public declarations }
procedure ChangeTimerTimer(Sender: TObject);
end;
var
Common: TCommon;
MutexHandle: THandle
//句柄
Mydesk_ICON: TICON;
ChangeTimer: TTimer
//切换定时器及下载定时器
reg: Tregistry;
nid: TNotifyIconData
//托盘区代码用到
SetMenu: TPopupMenu;
SetStartUP, ExitItem: TmenuItem;
function TCommon.GetCurDir: string;
begin
Result := ExtractFilePath(ParamStr(0));
if RightStr(Result, 1) <> '/' then Result := Result + '/';
end;
procedure TCommon.ExitItemClick;
begin
//去除托盘区图标
nid.cbSize := sizeOf(nid)
// nid变量的字节数
nid.uID := 18
//内部标识,与加入小图标时的数一致
nid.Wnd := MutexHandle
//主窗口句柄
Shell_NotifyIcon(NIM_DELETE, @nid)
//去掉小图标
CloseHandle(MutexHandle);
Halt
// 'Halt' Is stop running the actual application.
end;
procedure TCommon.ChangeTimerTimer;
begin
showmessage('OK');
end;
procedure TCommon.SetStartUPClick;
var
reg: Tregistry;
begin
reg := Tregistry.Create;
reg.RootKey := HKEY_LOCAL_MACHINE;
reg.OpenKey('SOFTWARE/Microsoft/Windows/CurrentVersion/Run', True);
if SetStartUP.Checked then begin
try
reg.DeleteValue('Renyuan');
SetStartUP.Checked := False;
except
end;
end
else begin
reg.WriteString('Renyuan', ParamStr(0));
SetStartUP.Checked := True;
end;
reg.closekey;
end;
{当小图标捕捉到鼠标事件时进入此过程}
procedure TCommon.OnIconNotify(var Message: TMessage);
var
MousePos: TPoint
//鼠标指针位置
begin
if Message.LParam = WM_LBUTTONDOWN then begin
SetForegroundWindow(MutexHandle)
//将程序调入前台
GetCursorPos(MousePos)
//当鼠标置于图标上时,获取鼠标位置
SetMenu.Popup(MousePos.X, MousePos.Y)
//在鼠标位置弹出菜单
end;
end;
procedure TCommon.CreateMenu;
begin
SetMenu := TPopupMenu.Create(nil);
with SetMenu.Items do begin
//建立启动设置项
SetStartUP := TmenuItem.Create(nil);
SetStartUP.Caption := '随Windows启动';
SetStartUP.OnClick := Common.SetStartUPClick;
SetStartUP.Checked := True;
Add(SetStartUP);
ExitItem := TmenuItem.Create(nil);
ExitItem.Caption := '退出';
ExitItem.OnClick := Common.ExitItemClick;
Add(ExitItem);
end;
end;
procedure TCommon.CreateTimer;
begin
//定时器,默认为2分
ChangeTimer := TTimer.Create(nil);
ChangeTimer.Interval := 120000;
ChangeTimer.Ontimer := Common.ChangeTimerTimer;
ChangeTimer.Enabled := True;
end;
begin
MutexHandle := CreateMutex(nil, True, '我的实验');
if MutexHandle <> 0 then begin
if GetLastError = ERROR_ALREADY_EXISTS then begin
CloseHandle(MutexHandle);
Halt;
end;
end;
Common.CreateMenu;
Common.CreateTimer;
//放图标至托盘区
nid.cbSize := sizeOf(nid)
// nid变量的字节数
nid.Wnd := MutexHandle
// 主窗口句柄
nid.uID := 18
// 内部标识,可设为任意数
Mydesk_ICON := TICON.Create;
Mydesk_ICON.LoadFromFile(Common.GetCurDir + 'mydesk.ico');
nid.hIcon := Mydesk_ICON.Handle;
// nid.hIcon := Application.Icon.Handle
// 要加入的图标句柄,可任意指定
nid.szTip := '我的实验'
// 提示字符串
nid.uCallbackMessage := MY_MESSAGE
// 回调函数消息
nid.uFlags := NIF_ICON or NIF_TIP or NIF_MESSAGE
// 指明哪些字段有效
if not Shell_NotifyIcon(NIM_ADD, @nid) then begin
showmessage('Failed!');
CloseHandle(MutexHandle);
Halt;
end;
ChangeTimer.Enabled := True
//开启事件
// WaitForSingleObject(MutexHandle, INFINITE);
end.
源码如下============================
program MyDesk;
uses
Windows, Messages, Graphics, SysUtils, Dialogs, shellapi,
ExtCtrls, Menus, StrUtils, registry, ExtDlgs, Controls, Classes;
const
MY_MESSAGE = WM_USER + 100
//捕获托盘区鼠标点击事件
{$R *.res}
type
TCommon = class
function GetCurDir: string;
procedure ExitItemClick(Sender: TObject);
procedure SetStartUPClick(Sender: TObject);
procedure CreateMenu;
procedure CreateTimer;
private
{ Private declarations }
procedure OnIconNotify(var Message: TMessage);
message MY_MESSAGE;
public
{ Public declarations }
procedure ChangeTimerTimer(Sender: TObject);
end;
var
Common: TCommon;
MutexHandle: THandle
//句柄
Mydesk_ICON: TICON;
ChangeTimer: TTimer
//切换定时器及下载定时器
reg: Tregistry;
nid: TNotifyIconData
//托盘区代码用到
SetMenu: TPopupMenu;
SetStartUP, ExitItem: TmenuItem;
function TCommon.GetCurDir: string;
begin
Result := ExtractFilePath(ParamStr(0));
if RightStr(Result, 1) <> '/' then Result := Result + '/';
end;
procedure TCommon.ExitItemClick;
begin
//去除托盘区图标
nid.cbSize := sizeOf(nid)
// nid变量的字节数
nid.uID := 18
//内部标识,与加入小图标时的数一致
nid.Wnd := MutexHandle
//主窗口句柄
Shell_NotifyIcon(NIM_DELETE, @nid)
//去掉小图标
CloseHandle(MutexHandle);
Halt
// 'Halt' Is stop running the actual application.
end;
procedure TCommon.ChangeTimerTimer;
begin
showmessage('OK');
end;
procedure TCommon.SetStartUPClick;
var
reg: Tregistry;
begin
reg := Tregistry.Create;
reg.RootKey := HKEY_LOCAL_MACHINE;
reg.OpenKey('SOFTWARE/Microsoft/Windows/CurrentVersion/Run', True);
if SetStartUP.Checked then begin
try
reg.DeleteValue('Renyuan');
SetStartUP.Checked := False;
except
end;
end
else begin
reg.WriteString('Renyuan', ParamStr(0));
SetStartUP.Checked := True;
end;
reg.closekey;
end;
{当小图标捕捉到鼠标事件时进入此过程}
procedure TCommon.OnIconNotify(var Message: TMessage);
var
MousePos: TPoint
//鼠标指针位置
begin
if Message.LParam = WM_LBUTTONDOWN then begin
SetForegroundWindow(MutexHandle)
//将程序调入前台
GetCursorPos(MousePos)
//当鼠标置于图标上时,获取鼠标位置
SetMenu.Popup(MousePos.X, MousePos.Y)
//在鼠标位置弹出菜单
end;
end;
procedure TCommon.CreateMenu;
begin
SetMenu := TPopupMenu.Create(nil);
with SetMenu.Items do begin
//建立启动设置项
SetStartUP := TmenuItem.Create(nil);
SetStartUP.Caption := '随Windows启动';
SetStartUP.OnClick := Common.SetStartUPClick;
SetStartUP.Checked := True;
Add(SetStartUP);
ExitItem := TmenuItem.Create(nil);
ExitItem.Caption := '退出';
ExitItem.OnClick := Common.ExitItemClick;
Add(ExitItem);
end;
end;
procedure TCommon.CreateTimer;
begin
//定时器,默认为2分
ChangeTimer := TTimer.Create(nil);
ChangeTimer.Interval := 120000;
ChangeTimer.Ontimer := Common.ChangeTimerTimer;
ChangeTimer.Enabled := True;
end;
begin
MutexHandle := CreateMutex(nil, True, '我的实验');
if MutexHandle <> 0 then begin
if GetLastError = ERROR_ALREADY_EXISTS then begin
CloseHandle(MutexHandle);
Halt;
end;
end;
Common.CreateMenu;
Common.CreateTimer;
//放图标至托盘区
nid.cbSize := sizeOf(nid)
// nid变量的字节数
nid.Wnd := MutexHandle
// 主窗口句柄
nid.uID := 18
// 内部标识,可设为任意数
Mydesk_ICON := TICON.Create;
Mydesk_ICON.LoadFromFile(Common.GetCurDir + 'mydesk.ico');
nid.hIcon := Mydesk_ICON.Handle;
// nid.hIcon := Application.Icon.Handle
// 要加入的图标句柄,可任意指定
nid.szTip := '我的实验'
// 提示字符串
nid.uCallbackMessage := MY_MESSAGE
// 回调函数消息
nid.uFlags := NIF_ICON or NIF_TIP or NIF_MESSAGE
// 指明哪些字段有效
if not Shell_NotifyIcon(NIM_ADD, @nid) then begin
showmessage('Failed!');
CloseHandle(MutexHandle);
Halt;
end;
ChangeTimer.Enabled := True
//开启事件
// WaitForSingleObject(MutexHandle, INFINITE);
end.