TMenuItem per Code aufklappen?

[uligerhardt]

Hallo zusammen,

kann man ein TMenuItem per Code aufklappen? Ich dachte an sowas wieItem.Click; , aber das funktioniert nicht. Es löst zwar bei Items ohne Untermenüpunkte die zugeordnete Aktion aus, klappt aber keine Untermenüs aus. Hat jemand eine Idee für mich?

Ciao,
Uli.

[uligerhardt]

Niemand?

[Sprint]

Hi,

mit der Win32 API Funktion TrackPopupMenu kannst du Menüs aufklappen.

[Andreas Schilling]

Kommt drauf an ob das TMenuItem zu einem PopupMenu oder MainMenu gehört.
  TPopupMenu.popup(Position von links, Position von oben);

[uligerhardt]

Zitat von Andreas Schilling:

Kommt drauf an ob das TMenuItem zu einem PopupMenu oder MainMenu gehört.
  TPopupMenu.popup(Position von links, Position von oben);

Ist leider ein MainMenu.

[Satty67]

um Sprint's Vorschlag nochmal zu konkretisieren:

Delphi-Quellcode:

function MenuItemPopup(ParentHWnd : THandle; AMenuItem : TMenuItem; X,Y : Integer) : Boolean;
var
  Flags : Integer;
begin
  Flags := TPM_LEFTALIGN or TPM_LEFTBUTTON;
  Result := TrackPopupMenu(AMenuItem.Handle, Flags, x, y, 0, ParentHWnd, nil);
end;

Viel Spass beim ermitteln der korrekten X/Y Position... hab in einem Test Form.Top/Left genommen (+Offset). Müsste man auch genau berechnen können, aber denke Try&Error geht da schneller.

AMenuItem muss ein TMEnuItem sein, das ein Untermenü hält...

[Sprint]

Hi,

ich habe im Visual Basic CodeGuru Forum einen Beitrag gefunden, der beschreibt wie man MenuItems aufklappen kann.
Leider keine Win32 API Funktion, sondern ein bißchen rum gefrickel.

CodeGuru Forum

Hab's ein wenig umgeändert. Mein Beispiel klappt das erste Menü auf.

Delphi-Quellcode:

procedure TForm1.Button1Click(Sender: TObject);

  function ScreenToAbsolute(const P: TPoint): TPoint;
  begin
    Result.X := P.X * (MAXWORD div GetSystemMetrics(SM_CXSCREEN));
    Result.Y := P.Y * (MAXWORD div GetSystemMetrics(SM_CYSCREEN));
  end;

var
  R: TRect;
  P: TPoint;
  C: TPoint;

begin

  GetMenuItemRect(Handle, Menu.Handle, 0, R);
  P.X := (R.Left + R.Right) div 2;
  P.Y := (R.Top + R.Bottom) div 2;
  P := ScreenToAbsolute(P);
  GetCursorPos(C);
  mouse_event(MOUSEEVENTF_ABSOLUTE Or MOUSEEVENTF_MOVE, P.X, P.Y, 0, GetMessageExtraInfo);
  mouse_event(MOUSEEVENTF_LEFTDOWN, 0, 0, 0, GetMessageExtraInfo);
  mouse_event(MOUSEEVENTF_LEFTUP, 0, 0, 0, GetMessageExtraInfo);
  SetCursorPos(C.X, C.Y);

end;

[uligerhardt]

Hallo Sprint,

danke für deinen Code. Hat in meinen kurzen Tests super funktioniert. Ich hab trotzdem noch ein bisschen dran rumgespielt und folgendes drausgemacht:

Delphi-Quellcode:

function ScreenToAbsolute(const P: TPoint): TPoint;
begin
  Result.X := P.X * (MAXWORD div GetSystemMetrics(SM_CXSCREEN));
  Result.Y := P.Y * (MAXWORD div GetSystemMetrics(SM_CYSCREEN));
end;

procedure ClickMenuItem(hWnd: HWND; hMenu: HMENU; uItem: UINT);
var
  R: TRect;
  P: TPoint;
  C: TPoint;
  Inputs: array[0..2] of TInput;
begin
  GetMenuItemRect(hWnd, hMenu, uItem, R);
  P.X := (R.Left + R.Right) div 2;
  P.Y := (R.Top + R.Bottom) div 2;
  P := ScreenToAbsolute(P);
  GetCursorPos(C);
  try
    FillChar(Inputs, SizeOf(Inputs), 0);

    Inputs[0].Itype := INPUT_MOUSE;
    Inputs[0].mi.dwFlags := MOUSEEVENTF_ABSOLUTE or MOUSEEVENTF_MOVE;
    Inputs[0].mi.dx := P.X;
    Inputs[0].mi.dy := P.Y;
    Inputs[0].mi.dwExtraInfo := GetMessageExtraInfo;

    Inputs[1].Itype := INPUT_MOUSE;
    Inputs[1].mi.dwFlags := MOUSEEVENTF_LEFTDOWN;
    Inputs[1].mi.dwExtraInfo := GetMessageExtraInfo;

    Inputs[2].Itype := INPUT_MOUSE;
    Inputs[2].mi.dwFlags := MOUSEEVENTF_LEFTUP;
    Inputs[2].mi.dwExtraInfo := GetMessageExtraInfo;

    SendInput(3, Inputs[0], SizeOf(Inputs[0]));
  finally
    SetCursorPos(C.X, C.Y);
  end;
end;

Ich hab jetzt nur Bedenken, dass das mit dem simulierten Mausklick in der freien Wildbahn irgendwann mal nach hinten losgeht.

Ciao,
Uli.