TTrayIcon mit MouseWheel Support

[corpsman]

Hallo Zusammen,

hat schon mal jemand außer mir versucht die TTrayicon Componente um ein OnMouseWheelUp / Down zu erweitern ?

Ich hab das versucht und bin gescheitert

Code: Alles auswählen

Unit uMyTrayIcon;

{$MODE ObjFPC}{$H+}

Interface

Uses
  Classes, SysUtils, ExtCtrls, LMessages;

Type

  { TMyTrayIcon }

  TMyTrayIcon = Class(TTrayIcon)
  private

  protected
    Procedure WMMouseWheel(Var Message: TLMMouseEvent); message LM_MOUSEWHEEL;
    Procedure WMMouseHWheel(Var Message: TLMMouseEvent); message LM_MOUSEHWHEEL;
  public

  End;

Implementation

Procedure Nop();
Begin

End;

{ TMyTrayIcon }

Procedure TMyTrayIcon.WMMouseWheel(Var Message: TLMMouseEvent);
Begin
  Nop();
  Message.Result := 1;
End;

Procedure TMyTrayIcon.WMMouseHWheel(Var Message: TLMMouseEvent);
Begin
  Nop();
  Message.Result := 1;
End;

End.

Wenn ich meine Anwendung Starte und entsprechend meine Componente Initialisiere, dann kommt der DBL Click, aber der Debugger macht keinen Halt, wenn ich mit dem Mausrad auf der Componente Scrolle

Code: Alles auswählen

Unit Unit1;

{$MODE objfpc}{$H+}

Interface

Uses
  Classes, SysUtils, Forms, Controls, Graphics, Dialogs, ExtCtrls, Menus,
  uMyTrayIcon, Types;

Type

  { TForm1 }

  TForm1 = Class(TForm)
    MenuItem1: TMenuItem;
    PopupMenu1: TPopupMenu;
    Procedure FormCreate(Sender: TObject);
    procedure FormMouseWheelDown(Sender: TObject; Shift: TShiftState;
      MousePos: TPoint; var Handled: Boolean);
    Procedure MenuItem1Click(Sender: TObject);
    Procedure TrayIcon1DblClick(Sender: TObject);
  private
    TrayIcon1: TMyTrayIcon;

  public

  End;

Var
  Form1: TForm1;

Implementation

{$R *.lfm}

{ TForm1 }

Procedure TForm1.FormCreate(Sender: TObject);
Begin
  TrayIcon1 := TMyTrayIcon.Create(self);
  TrayIcon1.Show;
  TrayIcon1.PopUpMenu := PopupMenu1;
  TrayIcon1.OnDblClick := @TrayIcon1DblClick;
End;

procedure TForm1.FormMouseWheelDown(Sender: TObject; Shift: TShiftState;
  MousePos: TPoint; var Handled: Boolean);
begin

end;

Procedure TForm1.MenuItem1Click(Sender: TObject);
Begin
  Close;
End;

Procedure TForm1.TrayIcon1DblClick(Sender: TObject);
Begin
  Showmessage('Doppelklick');
End;

End.

Leider verstehe ich von der LCL viel zu wenig um das ohne Hilfe hin zu bekommen und aus dem Code des TTrayicon habe ich auch nicht verstanden wie die das mit dem OnDblClick machen, die Volltextsuche findet kein hinweis in der customtrayicon.inc ..

[fliegermichl]

Wenn man ein TTrayIcon auf das Formular bappt, Doppelclick bei Events z.B. onClick und da einen Breakpoint draufsetzt, dann die Anwendung startet und das Trayicon anklickt, bekommt man bei Ansicht -> Debuggerfenster -> Aufrufstack angezeigt, wie das Programm an diese Stelle kommt.

Da ist bei mir unter anderem die Routine TrayWndProc in win32trayicon.inc.
Hier wird ausgewertet, was in LParam drinsteht.

Also baust du dir eine von TTrayIcon abgeleitete Klasse, deren wndproc Routine du überschreibst.
Darin kannst du dann auf die Events prüfen und einen fOnWheel... Event feuern lassen.

[corpsman]

Servus, danke auf das hätte ich eigentlich auch kommen können

Diesem Schema folgende habe ich einfach einen Haltepunkt in der existierenden Callback gemacht und geschaut ob die Funktion überhaupt aufgerufen wird, wenn man auf der "fläche" in der Trayleiste das Mausrad dreht -> kein Einsprung, man muss also irgendwo wohl noch registrieren das man die Wheel Events haben will.

Was auch merkwürdig ist wie das überhaupt geht, denn

TWin32WSCustomTrayIcon -> TWSCustomTrayIcon -> TWSLCLComponent -> TObject

und ich hatte aber ne Instanz von

TMyTrayIcon -> TTrayIcon -> TCustomTrayIcon -> TLCLComponent -> TComponent -> TPersistent -> TObject
erstellt.

Nach deiner Anweisung müsste ich ja von TWin32WSCustomTrayIcon ableiten und dann dort die Show überschreiben ??

[fliegermichl]

Stimmt, wndproc gibt es nur für Klassen, die von TControl abgeleitet werden.

Ich habe jetzt mal nach TrayWndProc suchen lassen und da fällt auf, daß in win32trayicon.inc ab Zeile 223 in der class Function TWin32WSCustomTrayIcon.Show eine Recordvariable vom Typ Windows.TWndClassEx befüllt wird und dabei dem Feld lpfnWndProc := @TrayWndProc zugewiesen wird. Am Ende wird dann Windows.RegisterClassEx aufgerufen.

Ich denke, daß man irgendwie hier eingreifen muß.
Aber ganz ehrlich so richtig habe ich die Zusammenhänge mit LCL <-> WidgetsetClasses und deren Zusammenspiel auch nicht kapiert.

[corpsman]

Würde mich nicht wundern wenn das so einfach gar nicht geht, denn eigentlich können die LCL klassen es ja...

Zum Glück ist das nur ein Nice to have und kein Muss für meine Application