Programm ohne Fenster in TNA ablegen

[hirnstroem]

'loha Folks,

http://www.delphipraxis.net/internal_redirect.php?t=137

^^ gemäss dieser Vorlage versuche ich ein Programm, welches keine Fenster hat, in der Tray Notification Area abzulegen, bekomme dies aber nicht hin -.-

Folgendermassen müsste die entsprechende Unit (in etwa) aussehen

Delphi-Quellcode:

unit UTrayNotificationArea;

interface

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

type
  TTrayNotificationArea = class(TForm) // <- da kein Formular fehlt ja dann auch irgendwie ein .dfm
    //
    procedure btnFACTSClick(Sender: TObject);
    procedure FACTSffnen1Click(Sender: TObject);
    procedure Beenden1Click(Sender: TObject);
  private
    { Private-Deklarationen }
    //
    TaskBarNewReg : DWORD;
    IconData: TNotifyIconData;
    pmTrayNotificationArea: TPopupMenu;
    IWStandAloneServer: TIWStandAloneServer;
    FACTSOeffnen1: TMenuItem;
    Beenden1: TMenuItem;
    //
  public
    { Public-Deklarationen }
    constructor Create; overload;
    destructor Destroy; overload;
    //
    procedure WndProc(var Msg: TMessage); override;
    procedure WMSysCommand(var Message: TWMSysCommand); message WM_SYSCOMMAND;
    //
  end;

var
  TrayNotificationArea: TTrayNotificationArea;

implementation

{$R *.dfm}

procedure TTrayNotificationArea.WndProc(var Msg: TMessage);
var 
  Point: TPoint; 
begin 
  // WM_USER + 20 is the TNA message 
  if Msg.Msg = WM_USER + 20 then
  begin
    // lParam contains the message
    case Msg.lParam of
      WM_RBUTTONUP:
      begin
        SetForegroundWindow(Handle);
        GetCursorPos(Point);
        pmTrayNotificationArea.PopUp(Point.X, Point.Y);
      end;
      WM_LBUTTONDBLCLK:
      begin
        IWStandAloneServer.Run;
      end;
    end;
  end
  else if Msg.Msg = TaskBarNewReg then
  begin
    Shell_NotifyIcon(NIM_ADD, @IconData);
  end;
  inherited;
end;

procedure TTrayNotificationArea.WMSysCommand(var Message: TWMSysCommand);
begin 
  // Fenster wurde minimiert 
  if Message.CmdType and $FFF0 = SC_MINIMIZE then 
  begin 
    Hide; 
    // show icon in tray
    Shell_NotifyIcon(NIM_ADD, @IconData); 
  end 
  else
  begin
    inherited;
  end;
end;

procedure TTrayNotificationArea.Beenden1Click(Sender: TObject);
begin
  Application.Terminate;
end;

procedure TTrayNotificationArea.btnFACTSClick(Sender: TObject);
begin
  IWStandAloneServer.Run;
end;

procedure TTrayNotificationArea.FACTSffnen1Click(Sender: TObject);
begin
  IWStandAloneServer.Run;
end;

constructor TTrayNotificationArea.Create;
begin
  // create popup menu and menu items
  pmTrayNotificationArea := TPopupMenu.Create(nil);
  FACTSOeffnen1 := TMenuItem.Create(pmTrayNotificationArea);
  FACTSOeffnen1.OnClick := FACTSffnen1Click;
  Beenden1 := TMenuItem.Create(pmTrayNotificationArea);
  Beenden1.OnClick :=  Beenden1Click;

  TaskBarNewReg := RegisterWindowMessage('TaskbarCreated');
  // IconData fill stucture
  IconData.cbSize := SizeOf(IconData);
  IconData.Wnd := Handle;
  IconData.uID := 100;
  IconData.uFlags := NIF_MESSAGE + NIF_ICON + NIF_TIP;
  IconData.uCallBackMessage := WM_USER + 20;
  IconData.hIcon := Application.Icon.Handle;
  IconData.szTip := 'FACTS Server Application';
  // show icon in tray (comment out if not needed)
  Shell_NotifyIcon(NIM_ADD, @IconData);
end;

destructor TTrayNotificationArea.Destroy;
begin
  Shell_NotifyIcon(NIM_DELETE, @IconData);
end;

initialization
  TrayNotificationArea.Create;

finalization
  TrayNotificationArea.Destroy;

end.

Bin ich da völlig auf dem Holzweg, oder lässt sich damit etwas anfangen?

Grüsse
hirnstroem

[DGL-luke]

..mit der initialization bist du auf jeden fall aus dem holzweg.

das muss Instance := Class.Create heißen, also

TrayNotificationArea := TTrayNotificationArea.Create; Ansonsten könnte das hinhauen, es würde aber reichen, von TWinControl abzuleiten (oder ein message-only window zu erstellen)

[hirnstroem]

In der Tat, das Funktioniert.

Die Compiler Direktive musste noch weg.

Instance := Class.Create hat mir beim zweiten Hinsehen auch eingeleuchtet.

IconData.Wnd := Handle; // kann ja auch nicht funktionieren -> muss weg Und so sieht jetzt aus.

Delphi-Quellcode:

unit UTrayNotificationArea;

interface

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

type
  TTrayNotificationArea = class(TWinControl)
    //
    procedure btnFACTSClick(Sender: TObject);
    procedure FACTSffnen1Click(Sender: TObject);
    procedure Beenden1Click(Sender: TObject);
  private
    { Private-Deklarationen }
    //
    TaskBarNewReg : DWORD;
    IconData: TNotifyIconData;
    pmTrayNotificationArea: TPopupMenu;
    IWStandAloneServer: TIWStandAloneServer;
    FACTSOeffnen1: TMenuItem;
    Beenden1: TMenuItem;
    //
  public
    { Public-Deklarationen }
    constructor Create; overload;
    destructor Destroy; overload;
    //
    procedure WndProc(var Msg: TMessage); override;
    procedure WMSysCommand(var Message: TWMSysCommand); message WM_SYSCOMMAND;
    //
  end;

var
  TrayNotificationArea: TTrayNotificationArea;

implementation

procedure TTrayNotificationArea.WndProc(var Msg: TMessage);
var 
  Point: TPoint; 
begin 
  // WM_USER + 20 is the TNA message 
  if Msg.Msg = WM_USER + 20 then
  begin
    // lParam contains the message
    case Msg.lParam of
      WM_RBUTTONUP:
      begin
        SetForegroundWindow(Handle);
        GetCursorPos(Point);
        pmTrayNotificationArea.PopUp(Point.X, Point.Y);
      end;
      WM_LBUTTONDBLCLK:
      begin
        IWStandAloneServer.Run;
      end;
    end;
  end
  else if Msg.Msg = TaskBarNewReg then
  begin
    Shell_NotifyIcon(NIM_ADD, @IconData);
  end;
  inherited;
end;

procedure TTrayNotificationArea.WMSysCommand(var Message: TWMSysCommand);
begin 
  // Fenster wurde minimiert 
  if Message.CmdType and $FFF0 = SC_MINIMIZE then 
  begin 
    Hide; 
    // show icon in tray
    Shell_NotifyIcon(NIM_ADD, @IconData); 
  end 
  else
  begin
    inherited;
  end;
end;

procedure TTrayNotificationArea.Beenden1Click(Sender: TObject);
begin
  Application.Terminate;
end;

procedure TTrayNotificationArea.btnFACTSClick(Sender: TObject);
begin
  IWStandAloneServer.Run;
end;

procedure TTrayNotificationArea.FACTSffnen1Click(Sender: TObject);
begin
  IWStandAloneServer.Run;
end;

constructor TTrayNotificationArea.Create;
begin
  // create popup menu and menu items
  pmTrayNotificationArea := TPopupMenu.Create(nil);
  FACTSOeffnen1 := TMenuItem.Create(pmTrayNotificationArea);
  FACTSOeffnen1.OnClick := FACTSffnen1Click;
  Beenden1 := TMenuItem.Create(pmTrayNotificationArea);
  Beenden1.OnClick :=  Beenden1Click;

  TaskBarNewReg := RegisterWindowMessage('TaskbarCreated');
  // IconData fill stucture
  IconData.cbSize := SizeOf(IconData);
  IconData.uID := 100;
  IconData.uFlags := NIF_MESSAGE + NIF_ICON + NIF_TIP;
  IconData.uCallBackMessage := WM_USER + 20;
  IconData.hIcon := Application.Icon.Handle;
  IconData.szTip := 'FACTS Server Application';
  // show icon in tray (comment out if not needed)
  Shell_NotifyIcon(NIM_ADD, @IconData);
end;

destructor TTrayNotificationArea.Destroy;
begin
  Shell_NotifyIcon(NIM_DELETE, @IconData);
end;

initialization
  TrayNotificationArea := TTrayNotificationArea.Create;

end.

Vielen Dank DGL-luke!

[hirnstroem]

Zu früh gefreut.

Beim Starten der Applikation erscheint nur zwar wie gewünscht ein Icon im Tray, dieses verschwindet aber rapide wieder, sprich, die Application schliesst sich selbst nachdem sie gestartet wurde.

[CCRDude]

Dir fehlt ja auch noch eine Message Loop. So das klassiche "repeat until quit", bzw. ein:

Delphi-Quellcode:

while GetMessage(@msgMain,0,0,0) do begin
      TranslateMessage(@msgMain);
      DispatchMessage(@msgMain);
   end;

Mit minimalem Messagehandling zumindest.

edit: oder, da Du Forms schon drin hast, das Dir bekannte Application....-Getöse.

Delphi-Quellcode:

Application.Initialize;
Application.OnMessage := << dein eigener handler
Application.OnException := << dein eigener handler
Application.ShowMainForm := FALSE;
Application.Run;
FExitEvent.WaitFor($FFFFFFFF); << wird von TMenuItem, der beenden soll, getriggert.
Application.OnMessage := nil;

[hirnstroem]

Das überfordert mich jetzt -.-

Bei mir heisst es jetzt

Delphi-Quellcode:

  while GetMessage(@Msg, 0, 0, 0) do begin
    TranslateMessage(@Msg);
    DispatchMessage(@Msg);
  end;

So gemacht, wird beim kompilieren ausgerufen:

Die Typen der tatsächlichen und formalen Var-Parameter müssen übereinstimmen

[CCRDude]

Siehe meine Edit im Post darüber, da Du Forms verwendest, hast Du wahrscheinlich auch nichts dagegen, das Application-Objekt zu verwenden, das auch ne Message-Schleife implementiert. Dazu ein FExitEvent vom Typ TEvent...