StartMenuPopup.pas

unit StartMenuPopup;

interface

uses
  Windows, Messages, Types, UITypes, Classes, Controls, Forms, Menus, UxPanel;

type
  TPopupMenu = class(Menus.TPopupMenu)
  private
    StartMenuCloseTime: UInt64;
    StartMenuToRemainClosed: Boolean;
    procedure StartButtonClick(Sender: TObject);
    procedure StartButtonMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure StartButtonMouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
  public
    procedure SetStartButton(AButton: TUxButton);
    procedure Popup(X, Y: Integer); override;
  end;

  TPopupMenuHelper = class helper for Menus.TPopupMenu
    procedure DoPrePopupWork(X, Y: Integer);
  end;

  TMenuItemHelper = class helper for Menus.TMenuItem
    procedure DoPrePopupWork;
  end;

implementation

uses
  Math;

const
  STARTMENU_TAG = 17926;

{ TPopupMenu }

procedure TPopupMenu.Popup(X, Y: Integer);
const
  Flags: array[Boolean, TPopupAlignment] of Word =
    ((TPM_LEFTALIGN, TPM_RIGHTALIGN, TPM_CENTERALIGN),
     (TPM_RIGHTALIGN, TPM_LEFTALIGN, TPM_CENTERALIGN));
  Buttons: array[TTrackButton] of Word = (TPM_RIGHTBUTTON, TPM_LEFTBUTTON);
var
  AFlags: Integer;
begin
  if (Tag = STARTMENU_TAG) and InRange(RTLVersion, 33, 34) then
  begin
    DoPrePopupWork(X, Y);
    AFlags := Flags[UseRightToLeftAlignment, Alignment] or Buttons[TrackButton] or
      (Byte(MenuAnimation) shl 10) or TPM_BOTTOMALIGN;
    if PopupComponent is TUxButton then
      TUxButton(PopupComponent).Down := True;
    try
      TrackPopupMenu(Items.Handle, AFlags, X, Y, 0 { reserved }, PopupList.Window, nil);
    finally
      if PopupComponent is TUxButton then
        TUxButton(PopupComponent).Down := False;
    end;
  end
  else
    inherited;
end;

procedure TPopupMenu.SetStartButton(AButton: TUxButton);
begin
  AutoPopup := False;
  Tag := STARTMENU_TAG;
  PopupComponent := AButton;
  AButton.PopupMenu := Self;
  AButton.OnClick := StartButtonClick;
  AButton.OnMouseDown := StartButtonMouseDown;
  AButton.OnMouseUp := StartButtonMouseUp;
end;

procedure TPopupMenu.StartButtonClick(Sender: TObject);
begin

  if not (Sender is TControl) then
    Exit;

  if StartMenuToRemainClosed then
  begin
    StartMenuToRemainClosed := False;
    Exit;
  end;

  with TControl(Sender).ClientToScreen(Point(0, 0)) do
    Popup(X, Y);

  StartMenuToRemainClosed := False;
  StartMenuCloseTime := GetTickCount64;

end;

procedure TPopupMenu.StartButtonMouseDown(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  StartMenuToRemainClosed := (StartMenuCloseTime <> 0) and (GetTickCount64 - StartMenuCloseTime < 100);
  StartMenuCloseTime := 0;
end;

procedure TPopupMenu.StartButtonMouseUp(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  StartMenuToRemainClosed := False;
end;

{ TPopupMenuHelper }

procedure TPopupMenuHelper.DoPrePopupWork(X, Y: Integer);
begin
  SetPopupPoint(Point(X, Y));
  with Self do SetBiDiModeFromPopupControl;
  DoPopup(Self);
  Items.DoPrePopupWork;
  AdjustBiDiBehavior;
end;

{ TMenuItemHelper }

procedure TMenuItemHelper.DoPrePopupWork;
begin
  with Self do
  begin
    InternalRethinkHotkeys(False);
    InternalRethinkLines(False);
    RebuildHandle;
  end;
end;

end.