Systray-Icon in eigener Klasse

[mika]

Hallo erstmal an alle,

ich probiere grad für eine Applikation eine Unit mit einer Klasse zu erstellen damit
ich einfach ein Icon im Systray plazieren kann und ein Menü bei Rechtsklick darauf
anzuzeigen. Das mit dem Icon klappt auch alles ganz gut aber ich bekomme die
CallbackMessage nicht mit -> will sagen bei Mausklick wird meine Prozedur nicht
aufgerufen :(

Folgendes zu dem Thema hab ich mir angesehen aber hat mir leider nciht weitergeholfen:

• DP Thread
• DP Thread
• DP Thread

Hier mal meine Unit:

Delphi-Quellcode:

(* *****************************************************************************
  Author := Mika
  Datum der Erstellung := 07-06-2005
  Datum der letzten Änderung := 07-06-2005

  Unit mit Methoden um ein Icon in der Trayleiste zu plazieren und
  auf dessen Ereignisse zu achten.
***************************************************************************** *)
unit uSystray;

interface

uses ShellApi, Windows, Messages, Forms;

Type
  TSystrayIcon = Class
    Trayicon: TNotifyIconData;

    Constructor newCreate(IconHint: String);
    Destructor newDestroy;

    private
      Procedure onTrayiconMessage(Var Msg: TMsg); message WM_USER;
      Procedure AddIconToSystray(TrayiconDescription: String);
      Procedure RemoveIconFromSystray;
  end;

implementation

Constructor TSystrayIcon.newCreate(IconHint: String);
Begin
  Inherited Create;
  AddIconToSystray(IconHint);
End;

Destructor TSystrayIcon.newDestroy;
Begin
  RemoveIconFromSystray;
  Inherited Destroy;
End;

(* *****************************************************************************
  Author := Mika
  Datum der Erstellung := 07-06-2005
  Datum der letzten Änderung := 07-06-2005

  Fügt dem Systray ein neues Icon hinzu das auf Mausklicks reagiert um
  ein Menü anzuzeigen.
***************************************************************************** *)
Procedure TSystrayIcon.AddIconToSystray(TrayiconDescription: String);
begin
  Fillchar(Trayicon.szTip, SizeOf(Trayicon.szTip), 0);

  Move(TrayiconDescription[1], Trayicon.szTip, Length(TrayiconDescription));
  Trayicon.cbSize := SizeOf(Trayicon);
  Trayicon.Wnd := Application.Handle;
  Trayicon.uFlags := NIF_ICON or NIF_TIP or NIF_MESSAGE;
  Trayicon.hIcon := Application.Icon.Handle;
  Trayicon.uID := 27787552;
  Trayicon.uCallbackMessage := WM_USER;

  Shell_NotifyIcon(NIM_DELETE, @Trayicon);
  Shell_NotifyIcon(NIM_ADD, @Trayicon);
end;

(* *****************************************************************************
  Author := Mika
  Datum der Erstellung := 07-06-2005
  Datum der letzten Änderung := 07-06-2005

  Entfernt das Trayicon aus dem Systray.
***************************************************************************** *)
Procedure TSystrayIcon.RemoveIconFromSystray;
Begin
  Shell_NotifyIcon(NIM_DELETE, @Trayicon);
End;

(* *****************************************************************************
  Author := Mika
  Datum der Erstellung := 07-06-2005
  Datum der letzten Änderung := 07-06-2005

  Reagiiert auf Mausklicks auf das Trayicon und zeigt ein
  Menü an bei Rechtsklick
***************************************************************************** *)
Procedure TSystrayIcon.onTrayiconMessage(Var Msg: TMsg);
Var
  Point: Tpoint;

Begin
  GetCursorPos(Point);
  if (Msg.wParam = WM_LBUTTONDOWN) then
  begin

  end else
  if (Msg.wParam = WM_RBUTTONDOWN) then
  begin

  end;
End;

end.

Die Prozedur onTrayiconMessage wird einfach nie aufgerufen, wäre nett wenn mir jemand da n Tipp
geben könnte !

Alles gute, Michael.

[Olli]

Schau dir mal TrackPopupMenu und Brüderchen TrackPopupMenuEx an ;)

[barf00s]

Delphi-Quellcode:

uses
  Menus;

type
  TSystrayIcon = class
  ...
  private
    FHandle: cardinal;
    FPopupMenu: TPopupMenu;
    WM_TASKBAREVENT: cardinal;
    WM_TASKBARCREATED: cardinal;
    procedure MessageHandler(var Msg: TMessage);
  ...
  end;


implementation

constructor TSystrayIcon.Create;
begin
  inherited;
  FHandle := AllocateHWnd(MessageHandler);
  WM_TASKBAREVENT := RegisterWindowMessage(ClassName);
  WM_TASKBARCREATED := RegisterWindowMessage('TaskbarCreated'); // wenn der explorer abscheißt, das das icon von deinem progrämmchen wiederhergestellt wird
  ...
end;

destructor TSystrayIcon.Destroy;
begin
  DeallocateHWnd(FHandle);
  ...
  inherited;
end;

procedure TSystrayIcon.MessageHandler(var Msg: TMessage);
begin
  if Msg.Msg = WM_TASKBAREVENT then begin
    ... hier dein GetCursorPos(ptCursor); ... if Assigned(FPopupMenu) then FPopupMenu.Popup(ptCursor.X, ptCursor.Y); ...
  end
  else if Msg.Msg = WM_TASKBARCREATED then
    AddIconToSysTray('blah');
end;

[Marphy]

Hallo zusammen!

@olli:
Ich glaube nicht, dass er das meint :wink:

@barf00s:
Ich bin auch grade bei dem Thema und habe das so gelöst (jetzt nur ausm Kopf):

Delphi-Quellcode:

uses
  {...,} ShellAPI;

type
  TForm1 = class(TForm)
    // ...
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    // ...
  private
    { Private-Deklarationen }
    FOldWndProc: TWndMethod;
    FTrayCallbackMsg: Cardinal;
    procedure MyWndProc(var Msg: TMessage);
  // ...
  end;

// ...

implementation

// ...

procedure TForm1.MyWndProc(var Msg: TMessage);
begin
  if Msg.Msg = FTrayCallbackMsg then begin
    case Msg.LParam of
      WM_LBUTTONDBLCLK: begin
        // ...
      end;
      WM_RBUTTONDOWN: begin
        // ...
      end
      // Weitere abzufragende Tray-Icon-Botschaften...
    end;
  end;
  FOldWndProc(Msg);
end;

procedure TForm1.FormCreate(Sender: TObject);
var
  TrayIcon: NOTIFYICONDATA;
begin
  // Tray-Icon hinzufügen
  // ...
  FTrayCallbackMsg := RegisterWindowMessage('MyTrayCallbackMessage');
  TrayIcon.uCallbackMessage := FTrayCallbackMsg;
  // ...

  // Eigene Window Procedure "registrieren"
  FOldWndProc := WindowProc;
  WindowProc := MyWndProc;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  WindowProc := FOldWndProc;
end;

Grüße, Marco

[Marphy]

Oops, den janzen Code hast du ja schon... Na jendenfalls, bei mir funktioniert's (nach meinem Code antürlich :stupid:).

Gruß, Marco

[barf00s]

naja, aber dann hasts nichmehr so schön gekapselt ... naja wers brauch

[Marphy]

Hmm, was machst du da mit AllocateWnd herum?!

Delphi-Quellcode:

procedure TSystrayIcon.Create(AOwnerForm: TForm);
  // ...
  FHandle := AOwnerForm.Handle;
  FOldWndProc := AOwnerForm.WindowProc; // Member hinzufügen!
  AOwnerForm.WindowProc := MessageHandler;
  // ...
end;

procedure TSystrayIcon.Destroy();
  // ...
  AOwnerForm.WindowProc := FOldWndProc;
  // ...
end;

Gruß, Marco

[barf00s]

mit dem AllocateHWnd erstellt mirn Handle für meine klasse, ohne das ich auf ne ParentForm/Application zurückgreifen muss und deren WindowProcs verändern muss
so kannst das traydingen für jedes andere program auch benutzen - auch wenns keine Form enthält

[mika]

Danke schonmal für die Antworten !!

@ Olli:
Das mit dem TrackPopupMenu schau ich mir nachher mal an!

@ barf00s:
Hab den Code so eingebaut bekomme aber in dem newCreate bei der Zeile:

Delphi-Quellcode:

  WM_TASKBAREVENT := RegisterWindowMessage(ClassName);

Die Fehlermeldung: Inkompatible Typen Shortstring und PChar! Stumpfes Typecasten hat
auch nicht geholfen mittels PChar()


Wisst Ihr Rat?

[Edit]
Ja ich will das gerne schön abgekapselt haben damits universeller bleibt und ich
möcht auch nicht wirklich gerne mit Forms arbeiten dabei ;) Will halt ne
schöne saubere Klasse haben wenns fertig ist.
[/Edit]

[Marphy]

Zitat:

Zitat von barf00s

mit dem AllocateHWnd erstellt mirn Handle für meine klasse, ohne das ich auf ne ParentForm/Application zurückgreifen muss und deren WindowProcs verändern muss
so kannst das traydingen für jedes andere program auch benutzen - auch wenns keine Form enthält

Ahh... Im Hintergrund macht die Prozedur aber auch nichts anderes, als ein unsichtbares Windowhandle zu erstellen. :mrgreen: