Nouvelles commandes pour le MAIN_MENU_POP

' test_main_menu_pop.bas

edit 1 : top 1,10 : left 1,10
memo 2 : top 2,10 : left 2,150
main_menu_pop 10
sub_menu 11 : parent 11,10 : caption 11,"Fichiers"

end

res% = dll_call2("PopupMenuTarget",object_internal(main_menu_popup%),handle(cible%))

' test_main_menu_pop.bas

dim res%

edit 1 : top 1,10 : left 1,10
memo 2 : top 2,10 : left 2,150
main_menu_pop 10
sub_menu 11 : parent 11,10 : caption 11,"Fichiers"

dll_on "KGF.dll"
res% = dll_call2("PopupMenuTarget",object_internal(10),handle(0))
message "res%="+str$(res%)

end

...
type
  Klaus = class
  public
    class procedure OnPopupMenu(Sender: TObject);
end;

implementation

{
  Cet routine évènement peut être appelée par un TPopupMenu juste avant son affichage à l'écran.
  La propriété TAG est utilisée pour mémoriser le handle d'un objet sur lequel de TPopupMenu est autorisé.
  Si TAG=0      ==> toujours afficher TPopupMenu
  Si TAG=-1    ==> jamais afficher le TPopupMenu
  Si TAG=handle ==> afficher le TPopupMenu uniquement si le curseur est sur cet objet
}
class procedure Klaus.OnPopupMenu(Sender: TObject);
var
  aName: array [0..255] of Char;
  hnd: HWND;
  pt: TPoint;
begin
  GetCursorPos(Pt);
  hnd := WindowFromPoint(Pt);
  GetClassName(hnd, aName, 256);
  if TPopupMenu(Sender).Tag<>0 then begin
    if TPopupMenu(Sender).Tag<>hnd then begin
      SendMessage(TPopupMenu(Sender).WindowHandle, WM_CANCELMODE, 0, 0 );
      keybd_event( VK_ESCAPE, Mapvirtualkey( VK_ESCAPE, 0 ), 0, 0);
      keybd_event( VK_ESCAPE, Mapvirtualkey( VK_ESCAPE, 0 ),KEYEVENTF_KEYUP, 0);
    end;
  end;
end;

// paramétrer le fonctionnement d'un TPopupMenu de Panoramic
function PopupMenuTarget(Popup: TControl; target: HWND): integer; stdcall; export;
var
  oldaddress: integer;
begin
  result := -1;
  try
    TPopupMenu(Popup).OnPopup := Klaus.OnPopupMenu;
    TPopupMenu(Popup).Tag := target;
    result := 0;
  except
  end;
end;
exports PopupMenuTarget;