首页 诗词 字典 板报 句子 名言 友答 励志 学校 网站地图
当前位置: 首页 > 教程频道 > .NET > .NET >

delphi服务程序写托盘程序,出现两个托盘图标,该怎么解决

2012-09-13 
delphi服务程序写托盘程序,出现两个托盘图标各位大虾,小弟最近在用delphi写一个服务程序。服务程序的功能是

delphi服务程序写托盘程序,出现两个托盘图标
各位大虾,小弟最近在用delphi写一个服务程序。服务程序的功能是启动一个带有界面的托盘程序。小弟新手,在网上找了一段程序,修修改改,终于能够运行。可每当运行这个服务的时候,任务栏右侧老是出现两个托盘图标。找来找去找不出原因,特此发帖请各位大虾帮忙看一下,万分感激。程序分两个部分,代码如下:
1.服务程序部分
unit Unit_Main;

interface

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

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;
  FrmMain: TFrmMain;

implementation

{$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.


2托盘程序
unit Unit_FrmMain;

interface

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

const
WM_TrayIcon = WM_USER + 1234;
type
  TFrmMain = class(TForm)

  Timer1: TTimer;
  Button1: TButton;
  procedure FormCreate(Sender: TObject);
  procedure Button1Click(Sender: TObject);
  procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
  procedure FormDestroy(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 := 10000;
Timer1.Enabled := True;

end;

 procedure SendHokKey;stdcall;
var
HDesk_WL: HDESK;
begin
HDesk_WL := OpenDesktop ('Winlogon', 0, False, DESKTOP_JOURNALPLAYBACK);
if (HDesk_WL <> 0) then
if (SetThreadDesktop (HDesk_WL) = True) then
PostMessage(HWND_BROADCAST, WM_HOTKEY, 0, MAKELONG (MOD_ALT or MOD_CONTROL, VK_DELETE));
end;


procedure TFrmMain.Button1Click(Sender: TObject);
var
dwThreadID : DWORD;
begin
CreateThread(nil, 0, @SendHokKey, nil, 0, dwThreadID);
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.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.SysButtonMsg(var Msg: TMessage);
begin
if (Msg.wParam = SC_CLOSE) or
(Msg.wParam = SC_MINIMIZE) then Hide
else inherited; 
end;

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




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

end.

[解决办法]
楼主看下, ?.dpr 源码里面(project --> view source) ,是不是 还有一句 Application.CreateForm(TFrmMain, FrmMain); 把这句注释掉...

在 .dpr 中已经创建了一次 FrmMain ,然后又
Svcmgr.Application.CreateForm(TFrmMain, FrmMain);
所以,FrmMain 创建了两次 ,所以出现两个 图标 。

[解决办法]
顶楼上

热点排行