原来可以做托盘图标的程序,转为服务之后,运行起来右下角会有两个托盘图标 ( 积分: 50 )

  • 主题发起人 主题发起人 yjpya
  • 开始时间 开始时间
Y

yjpya

Unregistered / Unconfirmed
GUEST, unregistred user!
各位朋友,小弟原来有一服务程序,可以实现变成托盘图标在右下角出现,但现在将这个程序注册成系统的一个服务后,虽然该服务可以启动,但右下角却出现了两个托盘图标,不知道代码哪一部分有问题,请各位朋友帮忙指出,多谢!!!(试过将Timer去掉和将Create多余的语句去掉都不成功)
unit Unit_FrmMain;//窗体部分

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ExtCtrls, ShellApi;


const
WM_TrayIcon = WM_USER + 1234;
type
TFrmMain = class(TForm)
Timer1: TTimer;
Button1: TButton;
procedure FormCreate(Sender: TObject);
procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
procedure FormDestroy(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
private
{ Private declarations }
IconData: TNotifyIconData;
procedure AddIconToTray;
procedure DelIconFromTray;
procedure TrayIconMessage(var Msg: TMessage); message WM_TrayIcon;
procedure SysButtonMsg(var Msg: TMessage); message WM_SYSCOMMAND;

public
{ Public declarations }
end;

var
FrmMain: TFrmMain;
gbCanClose: Boolean;

implementation

{$R *.dfm}

procedure TFrmMain.FormCreate(Sender: TObject);
begin

FormStyle := fsStayOnTop;
SetWindowLong(Application.Handle, GWL_EXSTYLE, WS_EX_TOOLWINDOW);
gbCanClose := False;
Timer1.Interval := 1000;
Timer1.Enabled := True;


end;

procedure TFrmMain.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
CanClose := gbCanClose;
if not CanClose then
begin
Hide;
end;
end;

procedure TFrmMain.FormDestroy(Sender: TObject);
begin
Timer1.Enabled := False;
DelIconFromTray;
end;


procedure TFrmMain.Button1Click(Sender: TObject);
var
dwThreadID: DWORD;
begin
// CreateThread(nil, 0, @SendHokKey, nil, 0, dwThreadID);
CreateThread(nil, 0, sender, nil, 0, dwThreadID);

end;

procedure TFrmMain.AddIconToTray;
begin
ZeroMemory(@IconData, SizeOf(TNotifyIconData));
IconData.cbSize := SizeOf(TNotifyIconData);
IconData.Wnd := Handle;
IconData.uID := 1;
IconData.uFlags := NIF_MESSAGE or NIF_ICON or NIF_TIP;
IconData.uCallbackMessage := WM_TrayIcon;
IconData.hIcon := Application.Icon.Handle;
IconData.szTip := 'Delphi服务演示程序';
Shell_NotifyIcon(NIM_ADD, @IconData);
end;

procedure TFrmMain.DelIconFromTray;
begin
Shell_NotifyIcon(NIM_DELETE, @IconData);
end;


procedure TFrmMain.TrayIconMessage(var Msg: TMessage);
begin
if (Msg.LParam = WM_LBUTTONDBLCLK) then Show();
end;

procedure TFrmMain.SysButtonMsg(var Msg: TMessage);
begin
if (Msg.wParam = SC_CLOSE) or
(Msg.wParam = SC_MINIMIZE) then Hide
else inherited; // 执行默认动作
end;

procedure TFrmMain.Timer1Timer(Sender: TObject);
begin
AddIconToTray;
end;

end.



unit Unit1;//服务部分

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, SvcMgr, Dialogs;

type
TDelphiService = class(TService)
procedure ServiceContinue(Sender: TService; var Continued: Boolean);
procedure ServiceExecute(Sender: TService);
procedure ServicePause(Sender: TService; var Paused: Boolean);
procedure ServiceShutdown(Sender: TService);
procedure ServiceStart(Sender: TService; var Started: Boolean);
procedure ServiceStop(Sender: TService; var Stopped: Boolean);
private
{ Private declarations }
public
function GetServiceController: TServiceController; override;
{ Public declarations }
end;

var
DelphiService: TDelphiService;



implementation

uses Unit_FrmMain;

{$R *.DFM}

procedure ServiceController(CtrlCode: DWord); stdcall;
begin
DelphiService.Controller(CtrlCode);
end;

function TDelphiService.GetServiceController: TServiceController;
begin
Result := ServiceController;
end;

procedure TDelphiService.ServiceContinue(Sender: TService;
var Continued: Boolean);
begin
while not Terminated do
begin
Sleep(10);
ServiceThread.ProcessRequests(False);
end;
end;

procedure TDelphiService.ServiceExecute(Sender: TService);
begin
while not Terminated do
begin
Sleep(10);
ServiceThread.ProcessRequests(False);
end;
end;


procedure TDelphiService.ServicePause(Sender: TService;
var Paused: Boolean);
begin
Paused := True;
end;

procedure TDelphiService.ServiceShutdown(Sender: TService);
begin
gbCanClose := true;
FrmMain.Free;
Status := csStopped;
ReportStatus();
end;

procedure TDelphiService.ServiceStart(Sender: TService;
var Started: Boolean);
begin
Started := True;
Svcmgr.Application.CreateForm(TFrmMain, FrmMain);
gbCanClose := False;
FrmMain.Hide;
end;

procedure TDelphiService.ServiceStop(Sender: TService;
var Stopped: Boolean);
begin
Stopped := True;
gbCanClose := True;
FrmMain.Free;
end;

end.
 
服务有个属性,是否允许桌面交互,默认是不允许的。
 
加一句
FIconData.hIcon := Forms.Application.Icon.Handle;
试试看

这个主要是此时FORM实际未被创建,ICON资源未读入造成的,我也碰到过。后参考Borland/Delphi/Source/Vcl/ScktSrve.dpr解决
 
后退
顶部