Einzelnen Beitrag anzeigen

hirnstroem

Registriert seit: 21. Sep 2005
297 Beiträge
 
Delphi 2006 Professional
 
#3

Re: Programm ohne Fenster in TNA ablegen

  Alt 5. Jun 2007, 13:12
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!
inde deus abest
  Mit Zitat antworten Zitat