TMenuBar を使った Menu の問題を修正します。詳しくはソース先頭のコメントをご覧ください。似た問題として QC#119282 と QC#101866 があります。

uFMXMenu.pas

{

■概要
TMenuBar を使った Main Menu の次の問題を修正します。 

1.マルチディスプレイで Form の X 座標がマイナス座標の時、
  メニューが座標 0, y に表示されてしまう問題 

2. OnMouseDown でメニューが選択されてしまう問題（通常は OnMouseUp で選択）

ただし厳密な動作検証はしていないので、ちょっとおかしな動作をするかもしれません。 

■使用方法
uFMXMenuUtils.pas を uses するだけで、修正されます。

}

unit uFMXMenuUtils;

interface

implementation

uses
  System.UITypes, System.Classes, System.Generics.Collections, System.Types
  , FMX.Types, FMX.Platform, FMX.Forms, FMX.Controls, FMX.Menus
  {$IFDEF MSWINDOWS}
  , FMX.Platform.Win, Winapi.Windows, Winapi.Messages, Winapi.ActiveX
  {$ENDIF}
  ;

type
  TMenuService = class(TInterfacedObject, IFMXMenuService)
  protected
    procedure StartMenuLoop(const AView: IMenuView);
    function ShortCutToText(ShortCut: TShortCut): String;
    procedure ShortCutToKey(
      ShortCut: TShortCut;
      var Key: Word;
      var Shift: TShiftState);
    function TextToShortCut(Text: String): Integer;
    procedure CreateOSMenu(
      AForm: TCommonCustomForm;
      const AMenu: IItemsContainer);
    procedure UpdateMenuItem(
      const AItem: IItemsContainer;
      AChange: TMenuItemChanges);
    procedure DestroyMenuItem(const AItem: IItemsContainer);
    function IsMenuBarOnWindowBorder: Boolean;
    procedure UpdateMenuBar;

  {$IFDEF MSWINDOWS}
  private
    FPleaseEnd: Boolean;
    FPopupForms: TList<TCustomPopupForm>;
    procedure PopupFormDestroy(Sender: TObject);
  protected
    procedure WindowsMenuLoop(const AView: IMenuView);
  {$ENDIF}
  end;

var
  GOrgMenuService: IFMXMenuService = nil;
  GMenuService: TMenuService;

procedure FixMenuItemClick;
begin
  if (GOrgMenuService <> nil) then
    Exit;

  TPlatformServices.Current.SupportsPlatformService(
    IFMXMenuService,
    IInterface(GOrgMenuService));

  if (GOrgMenuService = nil) then
    Exit;

  GMenuService := TMenuService.Create;

  TPlatformServices.Current.RemovePlatformService(IFMXMenuService);
  TPlatformServices.Current.AddPlatformService(IFMXMenuService, GMenuService);
end;

{ TMenuService }

procedure TMenuService.CreateOSMenu(
  AForm: TCommonCustomForm;
  const AMenu: IItemsContainer);
begin
  GOrgMenuService.CreateOSMenu(AForm, AMenu);
end;

procedure TMenuService.DestroyMenuItem(const AItem: IItemsContainer);
begin
  GOrgMenuService.DestroyMenuItem(AItem);
end;

function TMenuService.IsMenuBarOnWindowBorder: Boolean;
begin
  Result := GOrgMenuService.IsMenuBarOnWindowBorder;
end;

{$IFDEF MSWINDOWS}
procedure TMenuService.PopupFormDestroy(Sender: TObject);
begin
  if (Sender is TCustomPopupForm) then
    FPopupForms.Remove(TCustomPopupForm(Sender));
end;
{$ENDIF}

procedure TMenuService.ShortCutToKey(
  ShortCut: TShortCut;
  var Key: Word;
  var Shift: TShiftState);
begin
  GOrgMenuService.ShortCutToKey(ShortCut, Key, Shift);
end;

function TMenuService.ShortCutToText(ShortCut: TShortCut): String;
begin
  GOrgMenuService.ShortCutToText(ShortCut);
end;

procedure TMenuService.StartMenuLoop(const AView: IMenuView);
begin
  {$IFDEF MSWINDOWS}
  WindowsMenuLoop(AView);
  {$ELSE}
  GOrgMenuService.StartMenuLoop(AView);
  {$ENDIF}
end;

function TMenuService.TextToShortCut(Text: String): Integer;
begin
  Result := GOrgMenuService.TextToShortCut(Text);
end;

procedure TMenuService.UpdateMenuBar;
begin
  GOrgMenuService.UpdateMenuBar;
end;

procedure TMenuService.UpdateMenuItem(
  const AItem: IItemsContainer;
  AChange: TMenuItemChanges);
begin
  GOrgMenuService.UpdateMenuItem(AItem, AChange);
end;

{$IFDEF MSWINDOWS}
type
  TOpenMenuItem = class(TMenuItem);

procedure TMenuService.WindowsMenuLoop(const AView: IMenuView);
var
  FirstLoop: Boolean;

  procedure EndLoop;
  var
    View: IMenuView;
  begin
    View := AView;
    while View <> nil do
    begin
      View.Loop := False;
      View.Selected := nil;
      View := View.ParentView;
    end;

    FPopupForms.Clear;
  end;

  function ContinueLoop: Boolean;
  begin
    Result := AView.Loop;
  end;

  function ForwardSelectNextMenuItem(AView: IMenuView; AStartInd, AEndInd: Integer): Boolean;
  var
    I: Integer;
  begin
    if not Assigned(AView) then
      Exit(False);

    Result := False;
    for I := AStartInd to AEndInd do
      if AView.GetItem(I) is TMenuITem then
      begin
        AView.Selected := TMenuItem(AView.GetItem(I));
        Result := True;
        Break;
      end;
  end;

  function BackwardSelectNextMenuItem(AView: IMenuView; AStartInd, AEndInd: Integer): Boolean;
  var
    I: Integer;
  begin
    if not Assigned(AView) then
      Exit(False);

    Result := False;
    for I := AStartInd downto AEndInd do
      if AView.GetItem(I) is TMenuItem then
      begin
        AView.Selected := TMenuItem(AView.GetItem(I));
        Result := True;
        Break;
      end;
  end;

  procedure SelectFirstMenuItem(AView: IMenuView);
  begin
    ForwardSelectNextMenuItem(AView, 0, AView.GetItemsCount - 1);
  end;

  procedure SelectLastMenuItem(AView: IMenuView);
  begin
    BackwardSelectNextMenuItem(AView, AView.GetItemsCount - 1, 0);
  end;

  procedure SelectPrevMenuItem(AView: IMenuView);
  begin
    if not Assigned(AView) then
      Exit;

    if Assigned(AView.Selected) then
    begin
      { Select first Menu item from old selected to first }
      if BackwardSelectNextMenuItem(AView, AView.Selected.Index - 1, 0) then
        Exit;
      { Select first Menu item from last to old selected }
      BackwardSelectNextMenuItem(AView, AView.GetItemsCount - 1, AView.Selected.Index);
    end
    else
      SelectLastMenuItem(AView);
  end;

  procedure SelectNextMenuItem(AView: IMenuView);
  begin
    if not Assigned(AView) then
      Exit;

    if Assigned(AView.Selected) then
    begin
      { Select first Menu item from old selected to last }
      if ForwardSelectNextMenuItem(AView, AView.Selected.Index + 1, AView.GetItemsCount - 1) then
        Exit;
      { Select first Menu item from first to old selected }
      ForwardSelectNextMenuItem(AView, 0, AView.Selected.Index);
    end
    else
      SelectFirstMenuItem(AView);
  end;

var
  Msg: TMsg;
  WP: TPoint;
  P: TPointF;
  InMenus: Boolean;
  CurrentView, NewView: IMenuView;
  Obj: IControl;
  TimerId: THandle;

  PopupForm: TCustomPopupForm;
  Popup: TPopup;
  Last: TCustomPopupForm;
  Index: Integer;
  Left: Integer;
  PV: IMenuView;
  Item: TControl;
  Pos: TPointF;
begin
  PopupForm := nil;
  Left := 0;

  AView.Loop := True;
  TimerId := SetTimer(0, 0, 50, nil);
  try
    FirstLoop := True;
    while ContinueLoop do
    begin
      //--- FIXED case Form.Left < 0
      //--- START
      if (PopupForm = nil) then begin
        if (FPopupForms = nil) then
          FPopupForms := TList<TCustomPopupForm>.Create;

        Index := Screen.PopupFormCount - 1;
        PV := AView.ParentView;
        
        if (Index > -1) and (PV <> nil) then begin
          PopupForm := TCustomPopupForm(Screen.PopupForms[Index]);
          PopupForm.OnDestroy := PopupFormDestroy;

          if (PopupForm.PlacementTarget is TMenuItem) then begin
            Popup := AView.Parent as TPopup;
          
            Item := PopupForm.PlacementTarget as TMenuItem;
            Pos := PV.LocalToScreen(Item.Position.Point);

            if (FPopupForms.Count > 0) then begin
              Last := FPopupForms.Last;
              Pos.X := Last.Left + Last.Width - Popup.BorderWidth * 2;
            end;

            Pos.X := Pos.X - Popup.BorderWidth;
            Left := Trunc(Pos.X);

            FPopupForms.Add(PopupForm);
          end;
        end;
        
        PopupForm.Left := Left;
      end
      else 
        PopupForm.Left := Left;
      //--- END

      if FirstLoop then
        FirstLoop := False
      else
        WaitMessage;

      while ContinueLoop and PeekMessage(Msg, 0, 0, 0, PM_NOREMOVE) do
      begin
        case Msg.message of
          WM_WINDOWPOSCHANGING:
            begin
              EndLoop;
              Exit;
            end;
          WM_QUIT{, WM_NCLBUTTONDOWN..WM_NCMBUTTONDBLCLK}:
            begin
              EndLoop;
              Continue;
            end;
          WM_TIMER:
            begin
              TranslateMessage(Msg);
            end;
        end;
        if PeekMessage(Msg, 0, 0, 0, PM_REMOVE) then
        begin
          case Msg.message of
            WM_CONTEXTMENU: ;
            WM_NCMOUSEMOVE, WM_NCLBUTTONDOWN, WM_NCLBUTTONUP:
            begin
              case Msg.message of
                WM_NCMOUSEMOVE: begin
                  { Handle MouseOver }
                  {$IFDEF CPUX64}
                  WP := SmallPointToPoint(TSmallPoint(Cardinal(Msg.lParam)));
                  {$ELSE}
                  WP := SmallPointToPoint(TSmallPoint(Msg.lParam));
                  {$ENDIF}
                  P := PointF(WP.X, WP.Y);
                  Obj := AView.ObjectAtPoint(P);
                  TranslateMessage(Msg);
                  DispatchMessage(Msg);
                  { Find top level menu }
                  CurrentView := AView;
                  while CurrentView.ParentView <> nil do
                    CurrentView := CurrentView.ParentView;
                  { Check all items }
                  while CurrentView <> nil do
                  begin
                    Obj := CurrentView.ObjectAtPoint(P);
                    if (Obj <> nil) and (Obj.GetObject is TMenuItem) and not (TMenuItem(Obj.GetObject).IsSelected) then
                    begin
                      if (CurrentView <> AView) then
                      begin
                        NewView := AView;
                        while NewView <> CurrentView do
                        begin
                          NewView.Loop := False;
                          NewView := NewView.ParentView;
                        end;
                        TOpenMenuItem(Obj.GetObject).NeedPopup;
                        Exit;
                      end;
                    end;
                    CurrentView := CurrentView.ChildView;
                  end;
                  Continue;
                end;
                WM_NCLBUTTONDOWN: begin
                  { Handle MouseOver if mouse over not menuitem }
                  {$IFDEF CPUX64}
                  WP := SmallPointToPoint(TSmallPoint(Cardinal(Msg.lParam)));
                  {$ELSE}
                  WP := SmallPointToPoint(TSmallPoint(Msg.lParam));
                  {$ENDIF}
                  P := PointF(WP.X, WP.Y);
                  Obj := AView.ObjectAtPoint(P);
                  if (Obj <> nil) and not (Obj is TMenuItem) then
                  begin
                    TranslateMessage(Msg);
                    DispatchMessage(Msg);
                    Continue;
                  end;
                  { Menus }
                  if (Obj <> nil) and (Obj.GetObject is TMenuItem) then
                  begin
                    if not (TMenuItem(Obj.GetObject).IsSelected) and TMenuItem(Obj.GetObject).HavePopup then
                      TOpenMenuItem(Obj.GetObject).NeedPopup
                    else
                    begin
                      EndLoop;
                      TOpenMenuItem(Obj.GetObject).Click;
                    end;
                  end
                  else
                  begin
                    CurrentView := AView;
                    InMenus := False;
                    while (CurrentView <> nil) and not InMenus do
                    begin
                      if not (CurrentView.IsMenuBar) and (CurrentView.ObjectAtPoint(P) <> nil) then
                        InMenus := True;
                      CurrentView := CurrentView.ParentView;
                    end;
                    if not InMenus then
                      EndLoop;
                  end;
                end;
                WM_NCLBUTTONUP: begin
                  { Handle MouseOver if mouse over not menuitem }
                  {$IFDEF CPUX64}
                  WP := SmallPointToPoint(TSmallPoint(Cardinal(Msg.lParam)));
                  {$ELSE}
                  WP := SmallPointToPoint(TSmallPoint(Msg.lParam));
                  {$ENDIF}
                  P := PointF(WP.X, WP.Y);
                  Obj := AView.ObjectAtPoint(P);
                  if (Obj <> nil) and not (Obj is TMenuItem) then
                  begin
                    TranslateMessage(Msg);
                    DispatchMessage(Msg);
                    Continue;
                  end;
                end;
              end;
            end;
            WM_MOUSEFIRST..WM_MOUSELAST:
            begin
              case Msg.message of
                WM_MOUSEMOVE: begin
                  TranslateMessage(Msg);
                  DispatchMessage(Msg);
                  Continue;
                end;
                WM_LBUTTONDOWN: begin
                  { Handle MouseOver if mouse over not menuitem }
                  {$IFDEF CPUX64}
                  WP := SmallPointToPoint(TSmallPoint(Cardinal(Msg.lParam)));
                  {$ELSE}
                  WP := SmallPointToPoint(TSmallPoint(Msg.lParam));
                  {$ENDIF}
                  Winapi.Windows.ClientToScreen(Msg.hwnd, WP);
                  P := PointF(WP.X, WP.Y);
                  Obj := AView.ObjectAtPoint(P);
                  if (Obj <> nil) and not (Obj is TMenuItem) then
                  begin
                    TranslateMessage(Msg);
                    DispatchMessage(Msg);
                    Continue;
                  end;
                  { Menus }
                  if (Obj <> nil) and (Obj.GetObject is TMenuItem) then
                  begin
                    if not (TMenuItem(Obj.GetObject).IsSelected) and TMenuItem(Obj.GetObject).HavePopup then
                      TOpenMenuItem(Obj.GetObject).NeedPopup
                    else
                    begin
                      //--- FIXED EndLoop when mouse down
                      //--- START
                      FPleaseEnd := True
                      //EndLoop;
                      //TOpenMenuItem(Obj.GetObject).Click;
                      //--- END
                    end;
                  end
                  else
                  begin
                    CurrentView := AView;
                    InMenus := False;
                    while (CurrentView <> nil) and not InMenus do
                    begin
                      if not (CurrentView.IsMenuBar) and (CurrentView.ObjectAtPoint(P) <> nil) then
                        InMenus := True;
                      CurrentView := CurrentView.ParentView;
                    end;
                    if not InMenus then
                      EndLoop;
                  end;
                end;
                WM_LBUTTONUP: begin
                  //--- FIXED EndLoop when mouse down
                  //--- START
                  if (FPleaseEnd) then begin
                    FPleaseEnd := False;
                    EndLoop;
                    TOpenMenuItem(Obj.GetObject).Click;
                  end;
                  //--- END

                  { Handle MouseOver if mouse over not menuitem }
                  {$IFDEF CPUX64}
                  WP := SmallPointToPoint(TSmallPoint(Cardinal(Msg.lParam)));
                  {$ELSE}
                  WP := SmallPointToPoint(TSmallPoint(Msg.lParam));
                  {$ENDIF}
                  Winapi.Windows.ClientToScreen(Msg.hwnd, WP);
                  P := PointF(WP.X, WP.Y);
                  Obj := AView.ObjectAtPoint(P);
                  if (Obj <> nil) and not (Obj is TMenuItem) then
                  begin
                    TranslateMessage(Msg);
                    DispatchMessage(Msg);
                    Continue;
                  end;
                end;
              end;
            end;
            WM_KEYFIRST..WM_KEYLAST:
              if (GetKeyState(VK_LBUTTON) >= 0) then
                case Msg.message of
                  WM_KEYDOWN, WM_SYSKEYDOWN:
                    case Msg.wParam of
                      VK_TAB:
                      begin
                      end;
                      VK_RETURN:
                      begin
                        if (AView.Selected <> nil) then
                        begin
                          if AView.Selected.HavePopup then
                            AView.Selected.NeedPopup
                          else
                          begin
                            TOpenMenuItem(AView.Selected).Click;
                            EndLoop;
                          end;
                        end
                        else
                          EndLoop;
                      end;
                      VK_SPACE:
                      begin
                      end;
                      VK_ESCAPE:
                      begin
                        AView.Selected := nil;
                        Exit;
                      end;
                      VK_MENU, VK_F10:
                        EndLoop;
                      VK_LEFT:
                      begin
                        if AView.IsMenuBar then
                        begin
                          SelectPrevMenuItem(AView);
                        end
                        else
                          if (AView.ParentView <> nil) then
                            if (AView.ParentView.IsMenuBar) then
                            begin
                              AView.Loop := False;
                              SelectPrevMenuItem(AView.ParentView);
                              if AView.ParentView.Selected <> nil then
                                AView.ParentView.Selected.NeedPopup;
                              Exit;
                            end
                            else
                            begin
                              AView.Loop := False;
                            end;
                      end;
                      VK_RIGHT:
                      begin
                        if AView.IsMenuBar then
                        begin
                          SelectNextMenuItem(AView);
                        end
                        else
                        begin
                          if (AView.ParentView <> nil) then
                            if (AView.ParentView.IsMenuBar) then
                            begin
                              AView.Loop := False;
                              SelectNextMenuItem(AView.ParentView);
                              if AView.ParentView.Selected <> nil then
                                AView.ParentView.Selected.NeedPopup;
                              Exit;
                            end
                            else
                            begin
                              AView.Loop := False;
                            end;
                        end;
                      end;
                      VK_UP:
                        if not AView.IsMenuBar then
                          SelectPrevMenuItem(AView);
                      VK_DOWN:
                        if not AView.IsMenuBar then
                          SelectNextMenuItem(AView)
                        else
                          if AView.Selected <> nil then
                            AView.Selected.NeedPopup;
                    end;
                  WM_CHAR, WM_SYSCHAR: ;
                end;
          else
            TranslateMessage(Msg);
            DispatchMessage(Msg);
          end;
        end;
      end;
    end;
  finally
    KillTimer(0, TimerId);
    AView.Loop := False;
    Winapi.Windows.ReleaseCapture;
  end;
end;
{$ENDIF}

initialization
begin
  FixMenuItemClick;
end;

finalization
begin
end;

end.