控制台程序不能驻留内存(100分)

任远

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.
 
Application.Initialize;
Application.Run;
在最后的End.前面加上这两句试试
 
想要它不结束起码要添个简单的while循环来响应消息吧[:D]
 
你的程序没有消息循环如果处理消息呢?
楼上的方法可以一试
 
能麻烦各位直接在代码上改出来吗?第一次做控制台程序,摸不着头绪。
 
都没有窗口句柄,怎么传消息
用API创建一个窗口,不显示就行了。
 
必须有窗体吗?那我做的工作岂不白费了?我原来就是在Form中,现在是为了压缩大小,不想用窗体。
 
至少要有循环来响应消息啊,建议楼主看一下这个
http://www.codesky.net/showhtml/7658.htm
 
不用控制台也行啊,就没有控制台窗口
var
MSG: TMsg;
begin
while GetMessage(MSG, 0, 0, 0) do
begin
TranslateMessage(MSG);
DispatchMessage(MSG);
end
end. http://www.delphibbs.com/keylife/images/u196832/GetWindowTitle05-10.rar
 
在end. 前加了jfyes的代码,程序倒是驻留内存了,但仍不能正常响应事件,鼠标移到托盘区的图标上,图标自动消失了,到底是怎么回事?在form中是正常运行的代码。
 
http://www.delphibbs.com/keylife/images/u196832/APIMediaPlayer05-10.rar
去年的东西,不太好。
这个是API做的播放器,你看看吧,里面就有API做的托盘区的图标
http://www.delphibbs.com/keylife/iblog_show.asp?xid=19642
http://richpage.delphibbs.com/?jfyes=&t=prod
 

Similar threads

S
回复
0
查看
1K
SUNSTONE的Delphi笔记
S
S
回复
0
查看
933
SUNSTONE的Delphi笔记
S
S
回复
0
查看
3K
SUNSTONE的Delphi笔记
S
S
回复
0
查看
2K
SUNSTONE的Delphi笔记
S
I
回复
0
查看
396
import
I
顶部