Einfach das Popup Menü schließen

[Ginko]

Also beim Versuch das Popup Menü mit der mittleren Maustaste zu schließen komme ich nicht weiter.

Es soll ein Popup Menü, welches in einem Memo geöffnet wurde durch den Klick der mittleren Maustaste geschlossen werden. Eben genauso wie wenn ich mit der linken Maustaste neben das Menü klicke.

Mit dieser Lösung klappt es nicht http://www.swissdelphicenter.ch/de/showcode.php?id=2262.

Delphi-Quellcode:

procedure TForm1.Memo1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  if Button = mbMiddle then
      mouse_event(MOUSEEVENTF_LEFTDOWN, 0, 0, 0, 0);
      mouse_event(MOUSEEVENTF_LEFTUP, 0, 0, 0, 0);   
end;

Durch das Popup geht ja der Fokus verloren. Deshalb wird das Ereignis gar nicht mehr aufgerufen.
Aber wenn ich das ganze im Form1 Ereignis mache klappt es auch nicht.
Das Popup Menü hat ja kein MouseDown Ereignis.

Diese Lösung http://www.entwickler-ecke.de/topic_...d9d2ad?view=df habe ich noch gefunden. Aber bei mir meckert der Compiler (Lazarus), das er keine Popuplist kennt und außerdem
will er bei MakeObjectInstance(PopupListWndProc); immer noch eine Message als Argument bei PopupListWndProc.

[Ginko]

Ich habe eine Lösung gebastelt, welche mir aber sehr umständlich erscheint.
Dabei wird die Tastatur Global abgefragt, unabhängig vom Memo oder dem Formular.

Delphi-Quellcode:

unit Unit1;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, Menus,
  StdCtrls, ExtCtrls, Windows;

type

  { TForm1 }

  TForm1 = class(TForm)
    Memo1: TMemo;
    MenuItem1: TMenuItem;
    MenuItem2: TMenuItem;
    MenuItem3: TMenuItem;
    PopupMenu1: TPopupMenu;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    { private declarations }
  public
    { public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.lfm}

{ TForm1 }

procedure keytimer(WND: Hwnd; uMsg: DWord; IdEvent: DWord; dwTimer: DWord); stdcall; Far;
begin
  if Form1.Active then
  begin
    if getasynckeystate (VK_MBUTTON) <> 0 then
    begin
      mouse_event(MOUSEEVENTF_LEFTDOWN, 0, 0, 0, 0);
      mouse_event(MOUSEEVENTF_LEFTUP, 0, 0, 0, 0);
    end;
  end;
end;


procedure TForm1.FormCreate(Sender: TObject);
  Var TimerHandle: THandle;
Begin
  TimerHandle := SetTimer(0, 0, 100, @keytimer);
end;

procedure TForm1.FormDestroy(Sender: TObject);
Var TimerHandle: THandle;
begin
  KillTimer(0, TimerHandle);
end;

end.

[Uwe Raabe]

Warum so kompliziert?

Delphi-Quellcode:

procedure TForm1.Memo1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  if Button = mbMiddle then
    EndMenu;
end;

[Helmi]

Zitat:

Zitat von Ginko (Beitrag 1213160)

Ich habe eine Lösung gebastelt, welche mir aber sehr umständlich erscheint.
Dabei wird die Tastatur Global abgefragt, unabhängig vom Memo oder dem Formular.

Delphi-Quellcode:

unit Unit1;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, Menus,
  StdCtrls, ExtCtrls, Windows;

type

  { TForm1 }

  TForm1 = class(TForm)
    Memo1: TMemo;
    MenuItem1: TMenuItem;
    MenuItem2: TMenuItem;
    MenuItem3: TMenuItem;
    PopupMenu1: TPopupMenu;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    { private declarations }
  public
    { public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.lfm}

{ TForm1 }

procedure keytimer(WND: Hwnd; uMsg: DWord; IdEvent: DWord; dwTimer: DWord); stdcall; Far;
begin
  if Form1.Active then
  begin
    if getasynckeystate (VK_MBUTTON) <> 0 then
    begin
      mouse_event(MOUSEEVENTF_LEFTDOWN, 0, 0, 0, 0);
      mouse_event(MOUSEEVENTF_LEFTUP, 0, 0, 0, 0);
    end;
  end;
end;


procedure TForm1.FormCreate(Sender: TObject);
  Var TimerHandle: THandle;
Begin
  TimerHandle := SetTimer(0, 0, 100, @keytimer);
end;

procedure TForm1.FormDestroy(Sender: TObject);
Var TimerHandle: THandle;
begin
  KillTimer(0, TimerHandle);
end;

end.

Auch wenn es nicht dazugehört, aber deine Variable(n) "TimerHandle" muss unter private einmal deklariert werden und nicht in jeder Procedure lokal.

[Ginko]

Danke für die Antworten.
Ja dachte mir schon das da was faul ist, danke für den Hinweis Helmi.

Zitat:

Delphi-Quellcode:

procedure TForm1.Memo1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  if Button = mbMiddle then
    EndMenu;
end;

Funktioniert bei mir leider nicht (unter Lazarus) ob es unter Delphi geht kann ich grad nicht testen. Vielleicht später unter Delphi 7 mal.

[Ginko]

Der Befehl EndMenu; funktioniert zwar einwandfrei über einen Timer. Aber sobald das Popup Menü offen ist spricht die mittlere Maustaste nur noch auf globale Tastaturabfragen an.

Hier mal ein Beispiel:

Delphi-Quellcode:

uses
  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, Menus,
  ExtCtrls, StdCtrls, Windows;
.
.
.

var
  Form1: TForm1;
  z1: Integer = 0;

implementation

{$R *.lfm}

{ TForm1 }

procedure TForm1.Timer1Timer(Sender: TObject);
begin
  EndMenu;
  Inc(z1);
  Label1.Caption:= IntToStr(z1);
end;

procedure TForm1.MenuItem3Click(Sender: TObject);
begin
 ShowMessage('Test 3');
end;

procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  if Button = mbMiddle then ShowMessage('Reagiert nicht wenn Popup offen ist');
end;

procedure TForm1.PopupMenu1Popup(Sender: TObject);
begin
  Timer1.Enabled:= True; //Timer wird nach öffnen von Menü gestartet und beendet es nach entsprechender Zeit
end;

[Uwe Raabe]

Ich hatte das unter Delphi XE2 und Windows 7 getestet: Neue VCL-Forms-Anwendung, Memo drauf, MouseDown-Event wie gezeigt. Starten, rechte Maustaste auf Memo, Popup-Menü kommt, mittlere Maustaste auf Popupmenü - funktioniert.

[Ginko]

Hi hab es auch nochmal gerade so getestet unter Lazarus, es funktioniert wirklich. ABER nur mit dem Orginal Popup Menü von Windwos. Sobald ich ein eigenes verwende, tritt der oben beschriebene Fehler auf. Hast du es mit dem Orginal getestet ? Danke für die Mühe!

[Uwe Raabe]

Ja, ich hatte das Standardmenü genommen. Mit einem eigenen Popupmenü geht es in Delphi auch nicht. Liegt wohl daran, daß das Standardmenü mit dem Handle des Controls arbeitet, während die VCL-Popupmenüs ein anderes Window-Handle verwenden.

[Uwe Raabe]

Der folgende Code in einer passenden Unit sollte das aber beheben. Das funktioniert dann allerdings mit allen Popupmenüs und man braucht den Event i Memo nicht mehr.

Delphi-Quellcode:

type
  TMyPopupList = class(TPopupList)
  protected
    procedure WndProc(var Message: TMessage); override;
  end;

procedure TMyPopupList.WndProc(var Message: TMessage);
begin
  if Message.Msg = WM_MBUTTONDOWN then begin
    EndMenu;
    Exit;
  end;
  inherited;
end;

initialization
  PopupList.Free;
  PopupList := TMyPopupList.Create;
end.

[Ginko]

Ja das funktioniert prima unter Delphi, allerdings hat Lazarus keinen Typ TPopupList.

(Aus der Delphi Hilfe: TPopupList verwaltet das Fenster, in dem die Meldungen von Popup-Menüs angezeigt werden).

Etwas vergleichbares konnte ich bis jetzt auch nicht finden. Es gibt aber bei den Eigenschaften der Formulare, wo man u.a. das Popup Menü zuordnet, einen Punkt der PopupParent heißt, allerdings konnte ich noch keinen Wert finden den er hier annimmt.

[Uwe Raabe]

Dann scheint Lazarus noch eine andere Implementation zu haben. Leider kenne ich mich damit überhaupt nicht aus.

[Uwe Raabe]

Zitat:

Zitat von Ginko (Beitrag 1213232)

(Aus der Delphie Hilfe: TPopupList verwaltet das Fenster, in dem die Meldungen von Popup-Menüs angezeigt werden).

Die Deutsche Übersetzung ist etwas missverständlich. In dem Englischen Original wird das deutlicher:

Zitat:

TPopupList manages the window that handles popup menu messages.
TPopupList is the type of the global PopupList variable, which provides centralized message handling for all popup menus in an application.

Gemeint ist damit, daß die Windows-Messages für das geöffnete Popupmenu zentral von TPopupList bearbeitet werden. Im Fall des Standard-Menüs wird aber das Window-Handle des Controls verwendet, das zum Popup geführt hat. Daher kommen in meiner ersten Antwort alle Messages auch beim TMemo an. Bei einem VCL-Popupmenu behandelt TPopupList diese Messages und alles was es nicht kennt wird ignoriert. Aus diesem Grund funktioniert die abgeleitete Klasse, die die Standard PopupList ersetzt.

Keine Ahnung, wie Lazarus das macht.

[Ginko]

Trotzdem danke. Vielleicht weiß es ja hier noch jemand.

[JamesTKirk]

Zitat:

Zitat von Ginko (Beitrag 1213236)

Trotzdem danke. Vielleicht weiß es ja hier noch jemand.

Du könntest den Punkt von Uwe mit dem Beispiel hier kombinieren. Dabei geht es darum eigene Messages in einer eigenen WndProc zu behandeln, ähnlich wie Uwe es mit der TPopupList gezeigt hat. Lazarus bzw. die LCL ist hier intern anders aufgebaut, um die Cross Plattform Fähigkeit hinzubekommen, aber du kannst dennoch "Hacks" anwenden, um ein Widgetset speziell zu behandeln. Im Grunde musst du bei dem Beispiel statt

Delphi-Quellcode:

Self.Handle

das Handle deines Popupmenüs verwenden und den Code der WndProc anpassen (vergiss aber nicht dir die vorherige WndProc zu merken (dazu könntest du die Tag Property verwenden) und aufzurufen, wenn du nicht die gewünschte Nachricht erhalten hast (analog zu dem

Delphi-Quellcode:

inherited

in Uwes Beispiel)).

Eine wichtige Anmerkung ist hier jedoch, dass dies so nur unter Windows (Win32/64) funktionieren wird, unter Gtk2, Qt oder Carbon müsstest du eventuell andere Sachen ausprobieren, falls es dort überhaupt möglich ist andere Eingaben abzufangen...

Gruß,
Sven

[DeddyH]

Zitat:

Zitat von Uwe Raabe (Beitrag 1213212)

Delphi-Quellcode:

procedure TMyPopupList.WndProc(var Message: TMessage);
begin
  if Message.Msg = WM_MBUTTONDOWN then begin
    EndMenu;
    Exit;
  end;
  inherited;
end;

Wäre das so unter Verzicht auf Exit nicht lesbarer?

Delphi-Quellcode:

procedure TMyPopupList.WndProc(var Message: TMessage);
begin
  if Message.Msg = WM_MBUTTONDOWN then
    EndMenu
  else
    inherited;
end;

[Uwe Raabe]

Zitat:

Zitat von DeddyH (Beitrag 1213750)

Zitat:

Zitat von Uwe Raabe (Beitrag 1213212)

Delphi-Quellcode:

procedure TMyPopupList.WndProc(var Message: TMessage);
begin
  if Message.Msg = WM_MBUTTONDOWN then begin
    EndMenu;
    Exit;
  end;
  inherited;
end;

Wäre das so unter Verzicht auf Exit nicht lesbarer?

Delphi-Quellcode:

procedure TMyPopupList.WndProc(var Message: TMessage);
begin
  if Message.Msg = WM_MBUTTONDOWN then
    EndMenu
  else
    inherited;
end;

Das ist Geschmackssache und in diesem Fall ist sicher beides akzeptabel.

Bei komplexeren Fällen mit einer Vielzahl an Abfragen finde ich meinen Ansatz etwas übersichtlicher und leichter wartbar (z.B. beim Einfügen, Löschen oder Umsortieren einzelner Fälle).

Der IF-EXIT Ansatz hat gegenüber dem IF-ELSE Ansatz allerdings den Vorteil, daß nicht bei jedem IF ein EXIT folgen muss und in dem Fall die folgenden Abfragen noch ausgeführt werden. Bei einer IF-ELSE Struktur ist das nur schwer und unübersichtlich realisierbar.

Übrigens: Ich halte EXIT, BREAK und CONTINUE ebenso wie Exceptions für sehr brauchbare Sprachkonstrukte zur Steuerung des Programmflusses. Aber das gehört alles eigentlich gar nicht in diesen Thread :wink:

[DeddyH]

Och, mit Exit, Break, Continue und Exceptions habe ich (im Gegensatz zu with) auch kein Problem, ich fand es nur in diesem Fall eher verwirrend. Aber das soll jetzt bloß nicht in Grundsatzdiskussionen ausarten :D

[Ginko]

Danke für die Antworten.
So mein Test lief erfolglos, wobei ich zugeben muss, ich kaum weiß was ich da mache...
Compilerfehler kommt keiner. Eine Reaktion bekomme ich nur wenn ich das Handle auf Self lasse und nicht auf PopupMenü.

Delphi-Quellcode:

uses
  Windows;

var
  PrevWndProc: WNDPROC;

function WndCallback(Ahwnd: HWND; uMsg: UINT; wParam: WParam; lParam: LParam):LRESULT; stdcall;
  begin
    if uMsg=WM_MBUTTONDOWN then
    begin
      result:=Windows.DefWindowProc(Ahwnd, uMsg, WParam, LParam);  //not sure about this one
     // if result=windows.HTCAPTION then result:=windows.HTCLIENT;
      ShowMessage('Reaktion');
      exit;
    end;
    //Tag Property ??
    result:=CallWindowProc(PrevWndProc,Ahwnd, uMsg, WParam, LParam);
  end;


procedure TForm1.FormCreate(Sender: TObject);
begin
 PrevWndProc:=Windows.WNDPROC(SetWindowLongPtr(PopupMenu1.Handle,GWL_WNDPROC,PtrInt(@WndCallback)));
end;

Was ist eigentlich HTCAPTION ?

[DeddyH]

HTCAPTION etc. sind hier erklärt: WM_NCHITTEST

[Ginko]

Ah ok danke, auch wenns mir nicht wirklich weiter hilft.