// **************************************************************************************************
//
// Unit Vcl.Styles.Utils.Menus
// unit for the VCL Styles Utils
// https://github.com/RRUZ/vcl-styles-utils/
//
// The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License");
// you may not use this file except in compliance with the License. You may obtain a copy of the
// License at http://www.mozilla.org/MPL/
//
// Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF
// ANY KIND, either express or implied. See the License for the specific language governing rights
// and limitations under the License.
//
//
// Portions created by Mahdi Safsafi [SMP3]   e-mail SMP@LIVE.FR
// Portions created by Rodrigo Ruz V. are Copyright (C) 2013-2023 Rodrigo Ruz V.
// All Rights Reserved.
//
// **************************************************************************************************
// Contributors :
//
// gandf https://github.com/gandf
//
// **************************************************************************************************
unit Vcl.Styles.Utils.Menus;

interface

{$DEFINE UseVCLStyleUtilsMenu}
// {$IF CompilerVersion >= 27}    // uncomment these lines if you want to use the VCL Styles Menus Hooks
// {$UNDEF UseVCLStyleUtilsMenu}  // included on XE6-XE8  (Embarcadero Version)
// {$IFEND}                       //

uses
  System.Classes,
  System.Types,
  System.SysUtils,
  System.Math,
  Winapi.Windows,
  Winapi.Messages,
  Winapi.UxTheme,
  Vcl.Themes,
  Vcl.Graphics,
  Vcl.ImgList,
  Vcl.GraphUtil,
  Vcl.Controls,
  Vcl.Menus,
  Vcl.Styles.Utils.SysStyleHook;

const
  { The Undocumented Messages }
  MN_SETHMENU = $01E0;
  MN_GETHMENU = $01E1;
  MN_SIZEWINDOW = $01E2;
  MN_OPENHIERARCHY = $01E3;
  MN_CLOSEHIERARCHY = $01E4;
  MN_SELECTITEM = $01E5;
  MN_CANCELMENUS = $01E6;
  MN_SELECTFIRSTVALIDITEM = $01E7;
  MN_GETPPOPUPMENU = $01EA;
  MN_FINDMENUWINDOWFROMPOINT = $01EB;
  MN_SHOWPOPUPWINDOW = $01EC;
  MN_BUTTONDOWN = $01ED;
  MN_MOUSEMOVE = $01EE;
  MN_BUTTONUP = $01EF;
  MN_SETTIMERTOOPENHIERARCHY = $01F0;
  MN_DBLCLK = $001F1;
  MN_BUTTONDOWN_UP = $FFFFFFFC;
  MN_BUTTONDOWN_DOWN = $FFFFFFFD;
  WM_UAHDESTROYWINDOW = $0090;
  WM_UAHDRAWMENU = $0091;
  WM_UAHDRAWMENUITEM = $0092;
  WM_UAHINITMENU = $0093;
  WM_UAHMEASUREMENUITEM = $0094;
  WM_UAHNCPAINTMENUPOPUP = $0095;

  { MARLETT Font Char Const }
  MARLETT_RESTORE_CHAR = Char(50);
  MARLETT_MINIMIZE_CHAR = Char(48);
  MARLETT_CLOSE_CHAR = Char(114);
  MARLETT_MAXIMIZE_CHAR = Char(49);
  MARLETT_LEFT_ARROW_SCROLL_CHAR = Char(51);
  MARLETT_RIGHT_ARROW_SCROLL_CHAR = Char(52);
  MARLETT_UP_ARROW_SCROLL_CHAR = Char(53);
  MARLETT_DOWN_ARROW_SCROLL_CHAR = Char(54);
  MARLETT_PAGE_DOWN_ARROW_CHAR = Char(55);
  MARLETT_RIGHT_ARROW_SUBMENU_CHAR = Char(56);
  MARLETT_UP_ARROW_CHAR = Char(116);
  MARLETT_DOWN_ARROW_CHAR = Char(117);

type
  TSysPopupStyleHook = class;
  TSysPopupItemState = set of (isHot, isDisabled, isChecked, isDefault);
  TSysPopupItemStyle = (isNormal, isSep, isDropDown);

  TSysPopupStyleHook = class(TSysStyleHook)
  private type
{$REGION 'TSysPopupItem'}
    TSysPopupItem = class
    private
      FIndex: integer;
      FMenu: HMENU;
      FHandle: HWND;
      FSysParent: TSysControl;
      FSysPopupStyleHook: TSysPopupStyleHook;
      function GetItemRect: TRect;
      function IsItemDisabled: Boolean;
      function IsItemContainsSubMenu: Boolean;
      function IsItemSeparator: Boolean;
      function IsItemChecked: Boolean;
      function IsItemDefault: Boolean;
      function GetItemText: String;
      function GetVCLMenuItems: TMenuItem;
      function GetVCLMenuItemsFast: TMenuItem;
      function GetItemBitmap: HBITMAP;
      function IsItemRadioCheck: Boolean;
      // function isItemVisible: Boolean;
      function IsItemOwnerDraw: Boolean;
      function GetItemID: WORD;
      function GetVCLRealItem: TMenuItem;
    public
      constructor Create(SysPopupStyleHook: TSysPopupStyleHook; SysParent: TSysControl; const Index: integer; const Menu: HMENU); virtual;
      Destructor Destroy; override;
      property ID: WORD read GetItemID;
      property ItemRect: TRect read GetItemRect;
      property Disabled: Boolean read IsItemDisabled;
      property Separator: Boolean read IsItemSeparator;
      property HasSubMenu: Boolean read IsItemContainsSubMenu;
      property Checked: Boolean read IsItemChecked;
      // property Visible: Boolean read isItemVisible;
      property RadioCheck: Boolean read IsItemRadioCheck;
      property DefaultItem: Boolean read IsItemDefault;
      property Text: String read GetItemText;
      property OwnerDraw: Boolean read IsItemOwnerDraw;
      property VCLMenuItems: TMenuItem read GetVCLMenuItemsFast;
      property VCLItem: TMenuItem read GetVCLRealItem;
      property Bitmap: HBITMAP read GetItemBitmap;
    end;
{$ENDREGION}

  var
    FOffset: Integer;
    FOffsetCache: Integer;
    FSeparatorHeightCache: Integer;
    FItemHeightCache: Integer;
    FItemsPainted: Boolean;
    FParentSubItemPainted: Boolean;
    FPreviousHotItemIndex: integer;
    FPaintFirstItemFromMenu: Boolean;
    FKeyIndex: integer;
    FSysPopupItem: TSysPopupItem;
    FCount: integer;
    FMenu: HMENU;
    FVCLMenuItems: TMenuItem;
    FNCRect: TRect;
    FEnterWithKeyboard: Boolean;
    FPersistentHotKeys: Boolean;

    FMenuBarHook: TObject;
    function GetMenuFromHandle(AHandle: HWND): HMENU;
    function GetItemsCount: integer;
    procedure MNSELECTITEM(var Message: TMessage); message MN_SELECTITEM;
    procedure WMPRINT(var Message: TMessage); message WM_PRINT;
    function GetSysPopupItem(Index: integer): TSysPopupItem;
    function GetRightToLeft: Boolean;
  protected
    procedure EraseItem(Canvas: TCanvas; const Index: integer; const ItemRect: TRect); virtual;
    procedure DoDrawItem(Canvas: TCanvas; const Index: integer; const ForceIsNotHot: Boolean = False);
    procedure DrawItem(Canvas: TCanvas; const Index: integer; const ItemRect: TRect; const ItemText: String; const State: TSysPopupItemState;
      const Style: TSysPopupItemStyle); Virtual;
    procedure PaintBackground(Canvas: TCanvas); override;
    procedure GetNbSeparator(var PNbSeparator: Integer; const PIndex: Integer);
    function GetMenuItemHeight(const Index: Integer): Integer;
    function GetOffset(UseCache: Boolean): Integer;
    function ItemIsVisible(const Index: Integer): Boolean;
    procedure SetMaxOffset();
    procedure RefreshMenu();
    procedure GetItemHeight();
    procedure GetSeparatorHeight();
    function GetClientRectHeight(var PValue: TRect): Integer;
    function GetItemClicked(var PButton: Byte; PInitPos: TPoint): Integer;
    function GetMousePos(): TPoint;
    procedure WndProc(var Message: TMessage); override;
    procedure UpdateColors; override;
    procedure SetOffset(PValue: Integer);
    function GetBottom(const Index: Integer): Integer;
  public
    constructor Create(AHandle: THandle); override;
    Destructor Destroy; override;
    property Menu: HMENU read FMenu;
    property Items[Index: integer]: TSysPopupItem read GetSysPopupItem;
    property Count: integer read FCount;
    property RightToLeft: Boolean read GetRightToLeft;
    property Offset: Integer read FOffset write SetOffset;
  end;

implementation

{
  RANGE CHECKS OFF .
  IMPLICIT_STRING_CAST_LOSS OFF .
}
{$R-,WARN IMPLICIT_STRING_CAST_LOSS OFF}

uses
  Vcl.Forms,
  Vcl.Styles.Utils.Misc,
  Vcl.Styles.Utils.SysControls,
  Vcl.Styles.Utils.Graphics;

type
  TControlClass = Class(TControl);

function GetBmpInfo(hBmp: HBITMAP): Bitmap;
begin
  ZeroMemory(@Result, sizeof(Bitmap));
  GetObject(hBmp, sizeof(Result), @Result);
end;

function GetBitmapHeight(hBmp: HBITMAP): integer;
begin
  Result := GetBmpInfo(hBmp).bmHeight;
end;

function GetBitmapWidth(hBmp: HBITMAP): integer;
begin
  Result := GetBmpInfo(hBmp).bmWidth;
end;

function BmpToIcon(hBmp: HBITMAP): HICON;
var
  Bmp: Bitmap;
  hbmMask: HBITMAP;
  DC: HDC;
  piconinfo: TIconInfo;
  Icon: HICON;
begin
  Icon := 0;
  FillChar(Bmp, sizeof(Bitmap), Char(0));
  if GetObject(hBmp, sizeof(Bitmap), @Bmp) > 0 then
  begin
    DC := GetDC(0);
    if DC <> 0 then
      try
        hbmMask := CreateCompatibleBitmap(DC, Bmp.bmWidth, Bmp.bmHeight);
        if hbmMask <> 0 then
          try
            ZeroMemory(@piconinfo, sizeof(piconinfo));
            piconinfo.fIcon := True;
            piconinfo.hbmColor := hBmp;
            piconinfo.hbmMask := hbmMask;
            Icon := CreateIconIndirect(piconinfo);
          finally
            DeleteObject(hbmMask);
          end;
      finally
        ReleaseDC(0, DC);
      end;
  end;
  Result := Icon;
end;

function GetMenuItemPos(Menu: HMENU; ID: integer): integer;
var
  i: integer;
  pMenuItemInfo: TMenuItemInfo;
begin
  Result := -1;
  if Menu = 0 then
    Exit;
  for i := 0 to GetMenuItemCount(Menu) do
  begin
    FillChar(pMenuItemInfo, sizeof(pMenuItemInfo), Char(0));
    pMenuItemInfo.cbSize := sizeof(pMenuItemInfo);
    pMenuItemInfo.fMask := MIIM_ID;
    if (GetMenuItemInfo(Menu, i, True, pMenuItemInfo)) then
      if pMenuItemInfo.wID = Cardinal(ID) then
        Exit(i);
  end;
end;

function IsItemHILITE(Menu: HMENU; const ItemIndex: integer): Boolean;
var
  pMenuItemInfo: TMenuItemInfo;
begin
  Result := False;
  FillChar(pMenuItemInfo, sizeof(pMenuItemInfo), Char(0));
  pMenuItemInfo.cbSize := sizeof(TMenuItemInfo);
  pMenuItemInfo.fMask := MIIM_STATE;
  if GetMenuItemInfo(Menu, ItemIndex, True, pMenuItemInfo) then
    Result := (pMenuItemInfo.fState and MFS_HILITE) = MFS_HILITE;
end;

{ TSysPopupStyleHook }
constructor TSysPopupStyleHook.Create(AHandle: THandle);
begin
  inherited;
{$IF CompilerVersion > 23}
  StyleElements := [seFont, seClient, seBorder];
{$ELSE}
  OverridePaint := True;
  OverridePaintNC := True;
  OverrideFont := True;
{$IFEND}
  FPreviousHotItemIndex := -1;
  FKeyIndex := -1;
  FItemsPainted := False;
  FSysPopupItem := nil;
  FVCLMenuItems := nil;
  Offset := 0;
  FSeparatorHeightCache := 1;
  FItemHeightCache := 1;
  FEnterWithKeyboard  := False;
  FPersistentHotKeys  := False;
  FMenuBarHook := nil;
  // Font := Screen.MenuFont;
end;

destructor TSysPopupStyleHook.Destroy;
begin
  if Assigned(FSysPopupItem) then
    FreeAndNil(FSysPopupItem);
  inherited;
end;

procedure TSysPopupStyleHook.DoDrawItem(Canvas: TCanvas; const Index: integer; const ForceIsNotHot: Boolean = False);
var
  LRect, LRect2, LItemRect: TRect;
  P, P2: TPoint;
  State: TSysPopupItemState;
  Style: TSysPopupItemStyle;
  LText: String;
  SaveIndex: integer;
  LSysPopupItem: TSysPopupItem;
  ClientRectHeight: Integer;
begin
  if (Index < 0) or (Index > Count - 1) then
    Exit;

  LSysPopupItem := Items[Index];
  LItemRect := LSysPopupItem.ItemRect;
  P2 := Point(LItemRect.Left, LItemRect.Bottom);
  ScreenToClient(Handle, P2);
  P2.Y := P2.Y - GetOffset(True); //add offset

  GetMenuItemRect(0, FMenu, Index, LRect);
 //OutputDebugString(PChar(Format('Index %d  Width %d Height %d Left %d Top %d', [Index, LRect.Width, LRect.Height, LRect.Left, LRect.Top])));
  ClientRectHeight := GetClientRectHeight(LRect2);
  LRect2.Height := ClientRectHeight;

  //prevent draw  not visible items on larger menus
  if not PtInRect (LRect2, P2) then
    Exit;

  P := Point(LItemRect.Left, LItemRect.Top);
  ScreenToClient(Handle, P);
  P2 := P;
  P2.Y := P2.Y - GetOffset(True); //add offset

  if ClientRectHeight>LRect.Height then
    LRect2.Height:=  ClientRectHeight - LRect.Height;

  //prevent draw  not visible items on larger menus
  if not PtInRect (LRect2, P2) then
    Exit;

  LItemRect := Rect(P.X, P.Y, P.X + LItemRect.Width, P.Y + LItemRect.Height);


  if LItemRect.Left < 2 then
    LItemRect.Left := 2;
  inc(LItemRect.Right, 4);
  if LItemRect.Top < 2 then
    inc(LItemRect.Top, 2);
  { Item State }
  State := [];
  if not ForceIsNotHot then
    if index <> FPreviousHotItemIndex then
      Include(State, isHot);
  if LSysPopupItem.Disabled then
    Include(State, isDisabled);
  if LSysPopupItem.Checked then
    Include(State, isChecked);
  if LSysPopupItem.DefaultItem then
    Include(State, isDefault);
  { Item Style }
  Style := isNormal;
  if LSysPopupItem.Separator then
    Style := isSep;
  if LSysPopupItem.HasSubMenu then
    Style := isDropDown;

  LText := '';
  if Style <> isSep then
    LText := LSysPopupItem.Text;

  SaveIndex := SaveDC(Canvas.Handle);
  try
    EraseItem(Canvas, Index, LItemRect);
  finally
    RestoreDC(Canvas.Handle, SaveIndex)
  end;

  SaveIndex := SaveDC(Canvas.Handle);
  try
    DrawItem(Canvas, Index, LItemRect, LText, State, Style);
  finally
    RestoreDC(Canvas.Handle, SaveIndex)
  end;
end;

procedure TSysPopupStyleHook.DrawItem(Canvas: TCanvas; const Index: integer; const ItemRect: TRect; const ItemText: String; const State: TSysPopupItemState;
  const Style: TSysPopupItemStyle);
var
  LTextRect: TRect;
  DC: HDC;
  LPixelsPerInch: Integer;

  procedure DrawSubMenu(const ItemRect: TRect);
  var
    LBitmap: TBitmap;
    LSubMenuDetails: TThemedElementDetails;
    LSubMenuDetail: TThemedMenu;
    SubMenuSize: TSize;
    LSubMenuRect: TRect;
  begin
    LSubMenuRect := Rect(0, 0, 0, 0);
    LSubMenuDetail := tmPopupSubMenuNormal;
    if isDisabled in State then
      LSubMenuDetail := tmPopupSubMenuDisabled;
    LSubMenuDetails := StyleServices.GetElementDetails(LSubMenuDetail);
    StyleServices.GetElementSize(DC, LSubMenuDetails, esActual, SubMenuSize, LPixelsPerInch);
    if not RightToLeft then
      LSubMenuRect := Rect(ItemRect.Right - SubMenuSize.cx, ItemRect.Top, ItemRect.Right, ItemRect.Top + SubMenuSize.cy)
    else
      LSubMenuRect := Rect(ItemRect.Left + 4, ItemRect.Top, ItemRect.Left + 4 + SubMenuSize.Width, ItemRect.Bottom);
    LBitmap := TBitmap.Create;
    try
      LBitmap.SetSize(SubMenuSize.Width, SubMenuSize.Height);
      LBitmap.Canvas.Brush.Color := clFuchsia;
      LBitmap.Canvas.FillRect(Rect(0, 0, SubMenuSize.Width, SubMenuSize.Height));
      StyleServices.DrawElement(LBitmap.Canvas.Handle, LSubMenuDetails, Rect(0, 0, SubMenuSize.Width, SubMenuSize.Height), nil, LPixelsPerInch);
      if RightToLeft then
      begin
        RotateBitmap(LBitmap, DegToRad(180), False, clFuchsia);
        inc(LSubMenuRect.Top, (LBitmap.Height div 2) - 2);
      End
      else
        Dec(LSubMenuRect.Left, 4);

      TransparentBlt(DC, LSubMenuRect.Left, LSubMenuRect.Top, SubMenuSize.Width, SubMenuSize.Height, LBitmap.Canvas.Handle, 0, 0, SubMenuSize.Width,
        SubMenuSize.Height, clFuchsia);
    finally
      LBitmap.Free;
    end;
    Dec(LTextRect.Right, LSubMenuRect.Width);
  end;

  procedure DrawSpecialChar(DC: HDC; const Sign: Char; DestRect: TRect; const Bold: Boolean = False; const Disabled: Boolean = False);
  var
    LogFont: TLogFont;
    pOldFont: HGDIOBJ;
    AFont: HFONT;
    oldColor: COLORREF;
    OldMode: integer;
  begin
    LogFont.lfHeight := DestRect.Height;
    LogFont.lfWidth := 0;
    LogFont.lfEscapement := 0;
    LogFont.lfOrientation := 0;
    if Bold then
      LogFont.lfWeight := FW_BOLD
    else
      LogFont.lfWeight := FW_NORMAL;
    LogFont.lfItalic := 0;
    LogFont.lfUnderline := 0;
    LogFont.lfStrikeOut := 0;
    LogFont.lfCharSet := DEFAULT_CHARSET;
    LogFont.lfOutPrecision := OUT_DEFAULT_PRECIS;
    LogFont.lfClipPrecision := CLIP_DEFAULT_PRECIS;
    LogFont.lfQuality := DEFAULT_QUALITY;
    LogFont.lfPitchAndFamily := DEFAULT_PITCH;
    LogFont.lfFaceName := 'Marlett';

    if Disabled then
      oldColor := ColorToRGB(StyleServices.GetStyleFontColor(sfPopupMenuItemTextDisabled))
    else
    begin
      oldColor := ColorToRGB(StyleServices.GetStyleFontColor(sfPopupMenuItemTextNormal));
      if isHot in State then
        oldColor := ColorToRGB(StyleServices.GetStyleFontColor(sfPopupMenuItemTextHot));
      if isDisabled in State then
        oldColor := ColorToRGB(StyleServices.GetStyleFontColor(sfPopupMenuItemTextDisabled));
    end;

    AFont := CreateFontIndirect(LogFont);
    if AFont <> 0 then
      try
        oldColor := SetTextColor(DC, oldColor);
        pOldFont := SelectObject(DC, AFont);
        try
          OldMode := SetBkMode(DC, Transparent);
          Winapi.Windows.DrawText(DC, Sign, 1, DestRect, DT_LEFT or DT_SINGLELINE);
          SetBkMode(DC, OldMode);
          SelectObject(DC, oldColor);
        finally
          if pOldFont <> 0 then
            SelectObject(DC, pOldFont);
        end;
      finally
        DeleteObject(AFont);
      end;
  end;

var
  LThemedMenu: TThemedMenu;
  LDetails: TThemedElementDetails;
  LTextFormat: TTextFormat;
  LSize: TSize;
  LMenuItem: TMenuItem;
  LOwnerDrawState: TOwnerDrawState;
  P, LImageWidth, ImageIndex: integer;
  LImageRect, R: TRect;
  hBmp: HBITMAP;
  BmpHeight, BmpWidth: integer;
  Icon: HICON;
  DisplayCheckedGlyph: Boolean;
  Sign: Char;
  LSysPopupItem: TSysPopupItem;
  sShortCut: String;
  LBitmap: TBitmap;
  LParentMenu: TMenu;
  ItemRect2: TRect;


begin
  if Assigned(Application.Mainform) then
    LPixelsPerInch := Application.MainForm.Monitor.PixelsPerInch
  else
    LPixelsPerInch := screen.PixelsPerInch;
  DisplayCheckedGlyph := True;
  ItemRect2 := ItemRect;
  ItemRect2.Top := ItemRect.Top - GetOffset(True); //add offset
  ItemRect2.Height := ItemRect.Height;
  LTextRect := ItemRect2;
  { Fast access . }
  LSysPopupItem := Items[Index]; // Do not destroy !!
  DC := Canvas.Handle;
  R := ItemRect2;
  LThemedMenu := tmPopupItemNormal;
  if isHot in State then
    LThemedMenu := tmPopupItemHot;
  if isDisabled in State then
    LThemedMenu := tmPopupItemDisabled;
  if Style = isSep then
  begin
    LThemedMenu := tmPopupSeparator;
    inc(R.Left, 25);
  end;

  LDetails := StyleServices.GetElementDetails(LThemedMenu);

  if (isHot in State) and (LThemedMenu = tmPopupItemDisabled) then
  begin
    LDetails := StyleServices.GetElementDetails(tmPopupItemHot);
    LBitmap := TBitmap.Create;
    LBitmap.SetSize(R.Width, R.Height);
    LBitmap.PixelFormat := pf32bit;
    try
      Bitmap32_SetAlphaAndColor(LBitmap, 0, 0);
      StyleServices.DrawElement(LBitmap.Canvas.Handle, LDetails, Rect(0, 0, R.Width, R.Height));
      _Darkness32(LBitmap, 30);
      BitBlt(DC, R.Left, R.Top, R.Width, R.Height, LBitmap.Canvas.Handle, 0, 0, SRCCOPY);
    finally
      LBitmap.Free;
    end;
  end
  else
  if (LThemedMenu <> tmPopupItemNormal) and (LThemedMenu <> tmPopupItemDisabled) then
    StyleServices.DrawElement(DC, LDetails, R);

  if Style = isDropDown then
    DrawSubMenu(ItemRect2);

  LImageWidth := 0;
  LMenuItem := LSysPopupItem.VCLMenuItems;
  if LMenuItem <> nil then
    LMenuItem := LSysPopupItem.VCLItem;

  LParentMenu := nil;
  if (LMenuItem <> nil) then
    LParentMenu := LMenuItem.GetParentMenu;
  if (LParentMenu <> nil) and (LParentMenu.OwnerDraw) and (@LMenuItem.OnDrawItem <> nil) then
  begin
    LMenuItem.OnDrawItem(LMenuItem, Canvas, ItemRect2, (isHot in State));
    Exit;
  end;


  if (LParentMenu <> nil) and (LParentMenu.OwnerDraw) and (LMenuItem <> nil) and (@LMenuItem.OnAdvancedDrawItem <> nil) then
  begin
    LOwnerDrawState := [];

    if isHot in State then
      Include(LOwnerDrawState, odSelected);
    if isDisabled in State then
      Include(LOwnerDrawState, odDisabled);
    if isChecked in State then
      Include(LOwnerDrawState, odChecked);
    if isDefault in State then
      Include(LOwnerDrawState, odDefault);

    LMenuItem.OnAdvancedDrawItem(LMenuItem, Canvas, ItemRect2, LOwnerDrawState);
    Exit;
  end;

  if LMenuItem <> nil then
  begin
    { Draw Vcl PopupMenu Bitmap }
    ImageIndex := LMenuItem.ImageIndex;

      if (ImageIndex < 0) and (LMenuItem.Bitmap <> nil) then
      begin
        LBitmap := LMenuItem.Bitmap;
        if (LBitmap.Width = 16) and (LBitmap.Height = 16) then
        begin
          LImageWidth := LBitmap.Width;
          LImageRect := Rect(0, 0, LBitmap.Width, LBitmap.Height);
          RectVCenter(LImageRect, ItemRect2);

          if not RightToLeft then
            OffsetRect(LImageRect, 4, 0)
          else
          begin
            LImageRect.Left := ItemRect2.Right - LBitmap.Width - 4;
            LImageRect.Right := ItemRect2.Right;
          end;

          Canvas.Draw(LImageRect.Left, LImageRect.Top, LBitmap)
        end
        else
        if (LBitmap.Width > 0) and (LBitmap.Height > 0) then
        begin
          LImageWidth := 16;
          LImageRect := Rect(0, 0, 16, 16);
          RectVCenter(LImageRect, ItemRect2);
          if not RightToLeft then
            OffsetRect(LImageRect, 4, 0)
          else
          begin
            LImageRect.Left := ItemRect2.Right - 16 - 4;
            LImageRect.Right := ItemRect2.Right;
          end;

          if (LSysPopupItem.Checked) and (not LSysPopupItem.RadioCheck)  then
          begin
           R:=LImageRect;
           InflateRect(R, 2, 2);
           Canvas.Brush.Style:=bsClear;
           Canvas.Pen.Color  :=StyleServices.GetSystemColor(clHotLight);
           Canvas.Rectangle(R);
          end;

          Canvas.StretchDraw(LImageRect, LBitmap);
        end;

      end
      else
      if (LMenuItem.Parent <> nil) and (LMenuItem.Parent.SubMenuImages <> nil) and (ImageIndex > -1) then
      begin
        LImageWidth := LMenuItem.Parent.SubMenuImages.Width;
        DisplayCheckedGlyph := False;
        LImageRect := Rect(0, 0, LMenuItem.Parent.SubMenuImages.Width, LMenuItem.Parent.SubMenuImages.Height);
        RectVCenter(LImageRect, ItemRect2);

        if not RightToLeft then
          OffsetRect(LImageRect, 4, 0)
        else
        begin
          LImageRect.Left := ItemRect2.Right - LMenuItem.Parent.SubMenuImages.Width - 4;
          LImageRect.Right := ItemRect2.Right;
        end;

        if (LSysPopupItem.Checked) and (not LSysPopupItem.RadioCheck)  then
        begin
         R:=LImageRect;
         InflateRect(R, 2, 2);
         Canvas.Brush.Style:=bsClear;
         Canvas.Pen.Color  :=StyleServices.GetSystemColor(clHotLight);
         Canvas.Rectangle(R);
        end;

        LMenuItem.Parent.SubMenuImages.Draw(Canvas, LImageRect.Left, LImageRect.Top, ImageIndex);
      end
      else
      if (LParentMenu.Images <> nil) and (ImageIndex > -1) then
      begin
        LImageWidth := LParentMenu.Images.Width;
        DisplayCheckedGlyph := False;
        LImageRect := Rect(0, 0, LParentMenu.Images.Width, LParentMenu.Images.Height);
        RectVCenter(LImageRect, ItemRect2);

        if not RightToLeft then
          OffsetRect(LImageRect, 4, 0)
        else
        begin
          LImageRect.Left := ItemRect2.Right - LParentMenu.Images.Width - 4;
          LImageRect.Right := ItemRect2.Right;
        end;

        if (LSysPopupItem.Checked) and (not LSysPopupItem.RadioCheck)  then
        begin
         R:=LImageRect;
         InflateRect(R, 2, 2);
         Canvas.Brush.Style:=bsClear;
         Canvas.Pen.Color  :=StyleServices.GetSystemColor(clHotLight);
         Canvas.Rectangle(R);
        end;

        LParentMenu.Images.Draw(Canvas, LImageRect.Left, LImageRect.Top, ImageIndex, not LSysPopupItem.Disabled);
      end;
  end
  else if LSysPopupItem.Bitmap > 0 then
  begin
    hBmp := LSysPopupItem.Bitmap;
    if hBmp < HBMMENU_POPUP_MINIMIZE + 1 then
    begin
      { Draw System PopupMenu Bitmap }
      DisplayCheckedGlyph := False;

      case hBmp of
        HBMMENU_POPUP_RESTORE:
          Sign := MARLETT_RESTORE_CHAR;
        HBMMENU_POPUP_MINIMIZE, HBMMENU_MBAR_MINIMIZE_D:
          Sign := MARLETT_MINIMIZE_CHAR;
        HBMMENU_POPUP_MAXIMIZE:
          Sign := MARLETT_MAXIMIZE_CHAR;
        HBMMENU_POPUP_CLOSE, HBMMENU_MBAR_CLOSE_D:
          Sign := MARLETT_CLOSE_CHAR;
      else
        Sign := Char(0);
      end;
      if Sign <> #0 then
      begin
        LImageRect := Rect(0, 0, 10, 10);
        R := Rect(ItemRect2.Left, ItemRect2.Top, ItemRect2.Left + 30, ItemRect2.Bottom);
        RectCenter(LImageRect, ItemRect2);
        if not RightToLeft then
          LImageRect.Left := ItemRect2.Left + 6 //Fix center image
        else
        begin
          LImageRect.Left := ItemRect2.Right - 10 - 4;
          LImageRect.Right := ItemRect2.Right;
        end;
        DrawSpecialChar(DC, Sign, LImageRect, False, (isDisabled in State));
      end;
    end
    else
    begin
      { Draw PopupMenu Bitmap }
      BmpWidth := GetBitmapWidth(hBmp);
      BmpHeight := GetBitmapHeight(hBmp);
      if (BmpWidth > 0) and (BmpHeight > 0) then
      begin
        DisplayCheckedGlyph := False;
        LImageRect := Rect(0, 0, BmpWidth, BmpHeight);
        RectVCenter(LImageRect, ItemRect2);
        if not RightToLeft then
          OffsetRect(LImageRect, 4, 0)
        else
        begin
          LImageRect.Left := ItemRect2.Right - BmpWidth - 4;
          LImageRect.Right := ItemRect2.Right;
        end;

        Icon := BmpToIcon(hBmp);
        if Icon <> 0 then
        begin

          if (LSysPopupItem.Checked) and (not LSysPopupItem.RadioCheck)  then
          begin
           R:=LImageRect;
           InflateRect(R, 2, 2);
           Canvas.Brush.Style:=bsClear;
           Canvas.Pen.Color  :=StyleServices.GetSystemColor(clHotLight);
           Canvas.Rectangle(R);
          end;

          DrawIconEX(DC, LImageRect.Left, LImageRect.Top, Icon, BmpWidth, BmpHeight, 0, 0, DI_NORMAL);
          DeleteObject(Icon);
        end;
      end;
    end;
  end;

  if (LSysPopupItem.Checked)  then
  begin
    LThemedMenu := TThemedMenu(integer(tmPopupCheckNormal) + integer(LSysPopupItem.Disabled));
    if LSysPopupItem.RadioCheck then
      LThemedMenu := TThemedMenu(integer(tmPopupBulletNormal) + integer(LSysPopupItem.Disabled));
    LDetails := StyleServices.GetElementDetails(LThemedMenu);
    StyleServices.GetElementSize(DC, LDetails, esActual, LSize);
    LImageRect := Rect(0, 0, LSize.Width, LSize.Height);

    RectVCenter(LImageRect, ItemRect2);
    if DisplayCheckedGlyph then
    begin
      if not RightToLeft then
        OffsetRect(LImageRect, 4, 0)
      else
      begin
        LImageRect.Left := ItemRect2.Right - LSize.Width - 4;
        LImageRect.Right := ItemRect2.Right;
      end;
      StyleServices.DrawElement(DC, LDetails, LImageRect);
    end;
  end;

  { Draw Text }
  LTextFormat := [tfLeft, tfVerticalCenter, tfSingleLine, tfExpandTabs];//, tfHidePrefix];

//  if (LMenuItem.Parent<>nil) then
//   OutputDebugString(PChar(Format('LMenuItem.Parent %s IsItemHILITE %s', [LMenuItem.Parent.Caption, BoolToStr(IsItemHILITE(LMenuItem.Parent.Handle, LMenuItem.Parent.MenuIndex), True)])));

//  if FEnterWithKeyboard then
//    Exclude(LTextFormat, tfHidePrefix);

  if not RightToLeft then
    inc(LTextRect.Left, 28)
  else
  begin
    LTextRect.Left  := ItemRect2.Left;
    LTextRect.Right := ItemRect2.Right - 28;
    Exclude(LTextFormat, tfLeft);
    Include(LTextFormat, tfRtlReading);
    Include(LTextFormat, tfRight);
  end;

  if LImageWidth > 0 then
  begin
    if not RightToLeft then
      LTextRect.Left := ItemRect2.Left + LImageWidth + 8 + 4
    else
    begin
      LTextRect.Left := ItemRect2.Left;
      LTextRect.Right := ItemRect2.Right - LImageWidth - 8;
    end;
  end;

  LDetails := StyleServices.GetElementDetails(tmPopupItemNormal);
  if isHot in State then
    LDetails := StyleServices.GetElementDetails(tmPopupItemHot);
  if isDisabled in State then
    LDetails := StyleServices.GetElementDetails(tmPopupItemDisabled);

  if LSysPopupItem.DefaultItem then
    Canvas.Font.Style := [fsBold];

  if LMenuItem <> nil then
    DrawText(Canvas.Handle, LDetails, ItemText, LTextRect, LTextFormat)
  else
  begin
    sShortCut := '';
    // http://msdn.microsoft.com/en-us/library/ms647553%28v=VS.85%29.aspx#_win32_Menu_Shortcut_Keys
    P := Pos(#9, ItemText);
    if P > 1 then
    begin
      sShortCut := Copy(ItemText, P + 1, length(ItemText) - P);
      DrawText(Canvas.Handle, LDetails, Copy(ItemText, 1, P), LTextRect, LTextFormat)
    end
    else
      DrawText(Canvas.Handle, LDetails, ItemText, LTextRect, LTextFormat)
  end;

  {Draw vertical menu bar}
//  LDetailsBar := StyleServices.GetElementDetails(tmPopupSeparator);
//  LBitmapBar := TBitmap.Create;
//  LBitmapBar.SetSize(LTextRect.Height, LTextRect.Height);
//  LBitmapBar.PixelFormat := pf32bit;
//  LBitmapBar.AlphaFormat := afDefined;
//  LImageRect := Rect(0, 0, LBitmapBar.Width, LBitmapBar.Height);
//  R:=LImageRect;
//  try
//    StyleServices.DrawElement(LBitmapBar.Canvas.Handle, LDetailsBar, Rect(0, 0, R.Width, R.Height));
//    RotateBitmap(LBitmapBar, DegToRad(90), true);
//    BitBlt(DC, LTextRect.Left - 6, LTextRect.Top, 1, LTextRect.Height, LBitmapBar.Canvas.Handle, round(LTextRect.Height / 2), 0, SRCCOPY);
//  finally
//    LBitmapBar.Free;
//  end;

  { Draw ShortCut Text . }
  if LMenuItem <> nil then
  begin
    if LMenuItem.ShortCut <> 0 then
    begin
      sShortCut := ShortCutToText(LMenuItem.ShortCut);
      LTextRect := ItemRect2;
      if RightToLeft then
      begin
        LTextRect.Left := ItemRect2.Left + 14;
        LTextRect.Right := LTextRect.Left + Canvas.TextWidth(sShortCut);
      end
      else
      begin
        LTextRect.Left := ItemRect2.Right - 14 - Canvas.TextWidth(sShortCut);
        LTextRect.Right := ItemRect2.Right;
      end;
      DrawText(Canvas.Handle, LDetails, sShortCut, LTextRect, LTextFormat);
    end;
  end
  else if sShortCut <> '' then
  begin
    LTextRect := ItemRect2;
    if RightToLeft then
    begin
      LTextRect.Left := ItemRect2.Left + 14;
      LTextRect.Right := LTextRect.Left + Canvas.TextWidth(sShortCut);
    end
    else
    begin
      LTextRect.Left := ItemRect2.Right - 14 - Canvas.TextWidth(sShortCut);
      LTextRect.Right := ItemRect2.Right;
    end;
    DrawText(Canvas.Handle, LDetails, sShortCut, LTextRect, LTextFormat);
  end;
end;

procedure TSysPopupStyleHook.EraseItem(Canvas: TCanvas; const Index: integer; const ItemRect: TRect);
var
  LBitmap: TBitmap;
  LOffset: Integer;
begin
  LBitmap := TBitmap.Create;
  try
    LBitmap.SetSize(SysControl.Width, SysControl.Height);
    PaintBackground(LBitmap.Canvas);
    LOffset := GetOffset(True);
    BitBlt(Canvas.Handle, ItemRect.Left, ItemRect.Top - LOffset, ItemRect.Width, ItemRect.Height, LBitmap.Canvas.Handle, ItemRect.Left, ItemRect.Top - LOffset, SRCCOPY);
  finally
    LBitmap.Free;
  end;
end;

function TSysPopupStyleHook.GetItemsCount: integer;
begin
  Result := GetMenuItemCount(FMenu);
end;

function TSysPopupStyleHook.GetMenuFromHandle(AHandle: HWND): HMENU;
begin
  Result := HMENU(SendMessage(AHandle, MN_GETHMENU, 0, 0));
end;

function TSysPopupStyleHook.GetRightToLeft: Boolean;
var
  pMenuItemInfo: TMenuItemInfo;
begin
  Result := False;
  FillChar(pMenuItemInfo, sizeof(pMenuItemInfo), Char(0));
  pMenuItemInfo.cbSize := sizeof(TMenuItemInfo);
  pMenuItemInfo.fMask := MIIM_TYPE;
  if GetMenuItemInfo(FMenu, 0, True, pMenuItemInfo) then
    Result := ((pMenuItemInfo.fType and MFT_RIGHTORDER) = MFT_RIGHTORDER) or ((pMenuItemInfo.fType and MFT_RIGHTJUSTIFY) = MFT_RIGHTJUSTIFY);
end;

function TSysPopupStyleHook.GetSysPopupItem(Index: integer): TSysPopupItem;
begin
  Result := nil;
  if (Index > -1) and (index <= Count) then
  begin
    if Assigned(FSysPopupItem) then
      FreeAndNil(FSysPopupItem);
    FSysPopupItem := TSysPopupItem.Create(Self, SysControl, Index, FMenu);
    Result := FSysPopupItem;
  end;
end;

procedure TSysPopupStyleHook.PaintBackground(Canvas: TCanvas);
begin
  StyleServices.DrawElement(Canvas.Handle, StyleServices.GetElementDetails(tmPopupBorders), SysControl.ClientRect);
end;

procedure TSysPopupStyleHook.UpdateColors;
begin
  inherited;
  Font := Screen.MenuFont;
end;

type
  TSubMenuItemInfo = record
    Menu: HMENU;
    WindowHandle: HWND;
    ItemIndex: integer;
  end;

var
  SubMenuItemInfoArray: array of TSubMenuItemInfo;

procedure TSysPopupStyleHook.MNSELECTITEM(var Message: TMessage);
var
  DC: HDC;
  Canvas: TCanvas;
  Index, Index2: integer;
  i: WORD;
  L: integer;
  ParentItem: integer;
  ParentPopup: HWND;
  LMenu: HMENU;
  ArrowHeight: Integer;
  LDetails: TThemedElementDetails;
  R, FClientRect: TRect;
  LBitmap: TBitmap;
  LButton: Byte;
  LInitPos: TPoint;
begin
  { The undocumented MN_SELECTITEM Message:
    This is the most importants message ,
    Windows sends this message every time when the user
    select an item (not clicking, only select) ...
    wParam=Current Item Index .
    lparam= may be it's unused (not sure).
  }
  //
  Handled := False;
  DC := 0;
  Canvas := TCanvas.Create;
  try
    ParentPopup := 0;
    ParentItem := -1;
    DC := GetDC(Handle);
    Canvas.Handle := DC;
    Index := integer(Message.WParam);

    //OutputDebugString(PChar(Format('MNSELECTITEM Index %d', [Index])));

    if Assigned(Font) then
      Canvas.Font := Font;
    { Out of index . }
    if (Index > FCount - 1) or (Index < 0) then
    begin
      { Make sure that wParam hold a valid Item Index .
        if not .. then mouse is not on the PopupMenu
        => Remove Item highlight .
      }
      SetRedraw(True);
      if (FPreviousHotItemIndex > -1) and (FPreviousHotItemIndex < FCount) then
        DoDrawItem(Canvas, FPreviousHotItemIndex);
      FPreviousHotItemIndex := -1;
      Handled := True;
      Exit;
    end;

    if not FItemsPainted then
    begin
      { Items are not painted completely . }
      if Index = 0 then
      begin
        { draw up/dowm button }
        if GetBottom(Count - 1) - SysControl.ClientRect.Bottom > 0 then
        begin
          LBitmap := TBitmap.Create;
          FClientRect := SysControl.ClientRect;
          LBitmap.SetSize(FClientRect.Height, FClientRect.Height);
          LBitmap.PixelFormat := pf32bit;
          LBitmap.AlphaFormat := afDefined;
          if Assigned(Font) then
            LBitmap.Canvas.Font := Font;
          try
            PaintBackground(LBitmap.Canvas);
            FClientRect := SysControl.ClientRect;
            if Offset > 0 then
              LDetails := StyleServices.GetElementDetails(tsArrowBtnUpNormal)
            else
              LDetails := StyleServices.GetElementDetails(tsArrowBtnUpDisabled);
            GetItemHeight();
            ArrowHeight := trunc(FItemHeightCache / 2);
            R := FClientRect;
            R.Height := ArrowHeight;
            StyleServices.DrawElement(LBitmap.Canvas.Handle, LDetails, R);

            if ItemIsVisible(Count - 1) then
              LDetails := StyleServices.GetElementDetails(tsArrowBtnDownDisabled)
            else
              LDetails := StyleServices.GetElementDetails(tsArrowBtnDownNormal);
            R := FClientRect;
            R.Top := R.Top + R.Height - ArrowHeight;
            R.Height := ArrowHeight;
            StyleServices.DrawElement(LBitmap.Canvas.Handle, LDetails, R);

            BitBlt(DC, FClientRect.Left, FClientRect.Top, FClientRect.Width, FClientRect.Height, LBitmap.Canvas.Handle, 0, 0, SRCCOPY);
          finally
            LBitmap.Free;
          end;
        end;
      end;

      FPreviousHotItemIndex := Index;
      DoDrawItem(Canvas, Index);
      if (Index = Count - 1) then
      begin
        FItemsPainted := True;
        FPreviousHotItemIndex := -1;
      end;
      Handled := True;
      Exit;
    end;

    L := length(SubMenuItemInfoArray);
    if L <> 0 then
    begin
      for i := 0 to L - 1 do
      begin
        { Look for SubMenu Parent }
        LMenu := SubMenuItemInfoArray[i].Menu;
        if LMenu = FMenu then
        begin
          ParentPopup := SubMenuItemInfoArray[i].WindowHandle;
          ParentItem := SubMenuItemInfoArray[i].ItemIndex;
          Break;
        end;
      end;
    end;

    if (ParentPopup = Handle) then
      SetRedraw(True) { Allow drawing the current PopupMenu }
    else if ((ParentPopup <> Handle) and (FItemsPainted) and (ParentPopup <> 0)) then
    begin
      {
        if user jump so fast from the parent PopupMenu to the
        Child PopupMenu (SubMenu) , the hot item of parent Popup menu
        will be draw as a normal item (not hot)..
        So we need to repaint the hot item that drop the child popup menu.
      }
      if (not FParentSubItemPainted) and (ParentItem > -1) then
      begin
        SendMessage(ParentPopup, MN_SELECTITEM, ParentItem, 0);
        FParentSubItemPainted := True;
      end;
      { Don't Redraw the parent of the Current PopupMenu }
      // SetRedraw(ParentPopup, False);  //issue #81
    end;

    { if Item can drop a sub Popup Menu }
    if Items[Index].HasSubMenu then
    begin
      L := length(SubMenuItemInfoArray);
      if L = 0 then
      begin
        SetLength(SubMenuItemInfoArray, 1);
        SubMenuItemInfoArray[0].Menu := 0;
        L := 1;
      end;

      LMenu := GetMenuFromHandle(Handle);
      for i := 0 to L - 1 do
        { Avoid duplication }
        if SubMenuItemInfoArray[i].Menu <> LMenu then
        begin
          inc(L);
          SetLength(SubMenuItemInfoArray, L);
          SubMenuItemInfoArray[L - 1].Menu := GetSubMenu(FMenu, Index);
          SubMenuItemInfoArray[L - 1].WindowHandle := Handle;
          SubMenuItemInfoArray[L - 1].ItemIndex := Index;
          Break;
        end;
    end;

    LInitPos.X := 0;
    LInitPos.Y := 0;
    Index2 := GetItemClicked(LButton, LInitPos);
    if Index2 >= 0 then
      Index := Index2;

    { If all Items are painted }
    if FItemsPainted then
    begin
      { In order to show / hide SubMenu ,we need to
        process the default message handler . }
      SetRedraw(False);
      Message.Result := CallDefaultProc(Message);
      SetRedraw(True);
    end;

    if FPreviousHotItemIndex <> Index then
    begin
      { Draw Item normal . }
      DoDrawItem(Canvas, FPreviousHotItemIndex);
      { Draw Item hot . }
      DoDrawItem(Canvas, Index);
      FPreviousHotItemIndex := Index;
    end;

  finally
    Canvas.Handle := 0;
    Canvas.Free;
    if DC <> 0 then
      ReleaseDC(Handle, DC);
  end;
  Handled := True;
end;

procedure TSysPopupStyleHook.WMPRINT(var Message: TMessage);
var
  DC: HDC;
  i: integer;
  Canvas: TCanvas;
begin
  FMenu := GetMenuFromHandle(Handle);
  FCount := GetItemsCount;

  if Message.WParam <> 0 then
    DC := HDC(Message.WParam)
  else
    DC := GetDC(Handle);

  Canvas := TCanvas.Create;
  try
    Canvas.Handle := DC;
    PaintBackground(Canvas);
  finally
    Canvas.Handle := 0;
    Canvas.Free;
    if DC <> HDC(Message.WParam) then
      ReleaseDC(Handle, DC);
  end;

  FEnterWithKeyboard := (GetKeyState(VK_MENU) < 0);

  if Count > -1 then
  begin
    //exit;
    //FCount:=48;

//    for i := 0 to Count - 1 do
//    begin
//     GetMenuItemRect(0, FMenu, i, LRect);
//     OutputDebugString(PChar(Format('Index %d  Width %d Height %d Left %d Top %d', [i, LRect.Width, LRect.Height, LRect.Left, LRect.Top])));
//    end;

    for i := 0 + Offset to Count - 1 do
      PostMessage(Handle, MN_SELECTITEM, i, 0);
  end;
  Handled := True;
end;

function IsItemSeparator(Menu: HMENU; const ItemIndex: integer): Boolean;
var
  pMenuItemInfo: TMenuItemInfo;
begin
  {
    Use this function instead of Items[Index].Separator .
    ==> Fast access in WM_KEYDOWN .
  }
  Result := False;
  FillChar(pMenuItemInfo, sizeof(pMenuItemInfo), Char(0));
  pMenuItemInfo.cbSize := sizeof(TMenuItemInfo);
  pMenuItemInfo.fMask := MIIM_FTYPE;
  if GetMenuItemInfo(Menu, ItemIndex, True, pMenuItemInfo) then
    Result := (pMenuItemInfo.fType and MFT_SEPARATOR) = MFT_SEPARATOR;
end;

procedure TSysPopupStyleHook.GetNbSeparator(var PNbSeparator: Integer; const PIndex: Integer);
var
  i: Integer;
begin
  PNbSeparator := 0;
  GetItemHeight();
  GetSeparatorHeight();
  for i := 0 to PIndex - 1 do
  begin
    if IsItemSeparator(Menu, i) then
      Inc(PNbSeparator);
  end;
end;

function TSysPopupStyleHook.GetMenuItemHeight(const Index: Integer): Integer;
var
  LItemRect: TRect;
begin
  GetMenuItemRect(0, FMenu, Index, LItemRect);
  Result := LItemRect.Height;
end;

function TSysPopupStyleHook.GetBottom(const Index: Integer): Integer;
var
  LItemRect: TRect;
  P: TPoint;
begin
  GetMenuItemRect(0, FMenu, Index, LItemRect);
  P := Point(LItemRect.Left, LItemRect.Bottom);
  ScreenToClient(Handle, P);
  Result := P.Y;
end;

function TSysPopupStyleHook.GetOffset(UseCache: Boolean): Integer;
var
  LNbSeparator: Integer;
begin
  if (Offset = 0) and (GetBottom(Count - 1) <= SysControl.ClientRect.Bottom) then
  begin
    Result := 0;
    exit;
  end;

  if UseCache then
    if FOffsetCache <> 0 then
    begin
      Result := FOffsetCache;
      exit;
    end;

  GetNbSeparator(LNbSeparator, Offset);
  Result := ((Offset - LNbSeparator) * FItemHeightCache) + (LNbSeparator * FSeparatorHeightCache) - trunc(FItemHeightCache / 2);
  if UseCache then
    FOffsetCache := Result;
end;

procedure TSysPopupStyleHook.GetItemHeight();
var
  i: Integer;
begin
  if FItemHeightCache = 1 then
    for i := 0 to Count - 1 do
      if not IsItemSeparator(Menu, i) then
      begin
        FItemHeightCache := GetMenuItemHeight(i);
        exit;
      end;
  if FItemHeightCache = 1 then
    FItemHeightCache := 22;
end;

procedure TSysPopupStyleHook.GetSeparatorHeight();
var
  i: Integer;
begin
  if FSeparatorHeightCache = 1 then
    for i := 0 to Count - 1 do
      if IsItemSeparator(Menu, i) then
      begin
        FSeparatorHeightCache := GetMenuItemHeight(i);
        exit;
      end;
  if FSeparatorHeightCache = 1 then
    FSeparatorHeightCache := 8;
end;

procedure TSysPopupStyleHook.SetMaxOffset();
var
  LGap, LBottom: Integer;
begin
  { Search gap }
  LBottom := GetBottom(Count - 1);
  { No up/down button? }
  LGap :=  LBottom - SysControl.ClientRect.Bottom;
  if LGap <= 0 then
  begin
    Offset := 0;
    exit;
  end;

  { Search height to calc offset}
  GetItemHeight();

  { FItemHeightCache is for 2 buttons up/down }
  LGap :=  LGap + round(FItemHeightCache / 2);
  if LGap <= 0 then
  begin
    Offset := 0;
    exit;
  end;

  Offset := trunc(LGap / FItemHeightCache);

  while not ItemIsVisible(Count - 1) do
    Offset := Offset + 1;
end;

procedure TSysPopupStyleHook.RefreshMenu();
var
  DC: HDC;
  LBitmap: TBitmap;
  i, ArrowHeight: Integer;
  LDetails: TThemedElementDetails;
  R, FClientRect: TRect;
begin
  DC := 0;
  LBitmap := TBitmap.Create;
  FClientRect := SysControl.ClientRect;
  LBitmap.SetSize(FClientRect.Height, FClientRect.Height);
  LBitmap.PixelFormat := pf32bit;
  LBitmap.AlphaFormat := afDefined;
  if Assigned(Font) then
    LBitmap.Canvas.Font := Font;
  try
    DC := GetDC(Handle);
    PaintBackground(LBitmap.Canvas);
    for i := Offset to Count - 1 do
    begin
      if ItemIsVisible(i) then
        DoDrawItem(LBitmap.Canvas, i, True)
      else
        break;
    end;
    { draw up/dowm button }
    FClientRect := SysControl.ClientRect;
    if Offset > 0 then
      LDetails := StyleServices.GetElementDetails(tsArrowBtnUpNormal)
    else
      LDetails := StyleServices.GetElementDetails(tsArrowBtnUpDisabled);
    ArrowHeight := trunc(FItemHeightCache / 2);
    R := FClientRect;
    R.Height := ArrowHeight;
    StyleServices.DrawElement(LBitmap.Canvas.Handle, LDetails, R);

    if ItemIsVisible(Count - 1) then
      LDetails := StyleServices.GetElementDetails(tsArrowBtnDownDisabled)
    else
      LDetails := StyleServices.GetElementDetails(tsArrowBtnDownNormal);
    R := SysControl.ClientRect;
    R.Top := R.Top + R.Height - ArrowHeight;
    R.Height := ArrowHeight;
    StyleServices.DrawElement(LBitmap.Canvas.Handle, LDetails, R);

    BitBlt(DC, FClientRect.Left, FClientRect.Top, FClientRect.Width, FClientRect.Height, LBitmap.Canvas.Handle, 0, 0, SRCCOPY);
  finally
    LBitmap.Free;
    if DC <> 0 then
      ReleaseDC(Handle, DC);
  end;
end;

function TSysPopupStyleHook.ItemIsVisible(const Index: Integer): Boolean;
var
  LRect, LItemRect: TRect;
  P: TPoint;
  ClientRectHeight: Integer;
  LOffset: Integer;
begin
  result := True;
  if (Index < 0) or (Index >= Count) then
    Exit;

  GetMenuItemRect(0, FMenu, Index, LItemRect);
  P := Point(LItemRect.Left, LItemRect.Bottom);
  ScreenToClient(Handle, P);
  LOffset := GetOffset(True);
  P.Y := P.Y - LOffset;

  ClientRectHeight := GetClientRectHeight(LRect);
  LRect.Height := ClientRectHeight;

  //prevent draw  not visible items on larger menus
  Result := PtInRect (LRect, P);

  if Result then
  begin
    P := Point(LItemRect.Left, LItemRect.Top);
    ScreenToClient(Handle, P);
    P.Y := P.Y - LOffset;
    if ClientRectHeight > LItemRect.Height then
      LRect.Height :=  ClientRectHeight - LItemRect.Height;
    Result := PtInRect (LRect, P);
  end;
end;

function TSysPopupStyleHook.GetClientRectHeight(var PValue: TRect): Integer;
begin
  PValue := SysControl.ClientRect;
  Result := PValue.Height;
  { Use offset? }
  if GetBottom(Count - 1) - Result > 0 then
  begin
    GetItemHeight();
    Result := Result - FItemHeightCache;
  end;
end;

procedure TSysPopupStyleHook.SetOffset(PValue: Integer);
begin
  FOffset := PValue;
  FOffsetCache := 0;
end;

function TSysPopupStyleHook.GetItemClicked(var PButton: Byte; PInitPos: TPoint): Integer;
var
  ArrowHeight, i: Integer;
  R, LItemRect: TRect;
  Pos: TPoint;
begin
  PButton := 0;
  Result := -1;
  if (PInitPos.X = 0) and (PInitPos.Y = 0) then
    Pos := GetMousePos()
  else
  begin
    Pos := PInitPos;
    ScreenToClient(Handle, Pos);
  end;

  R := SysControl.ClientRect;

  if GetBottom(Count - 1) - R.Bottom > 0 then
  begin
    ArrowHeight := trunc(FItemHeightCache / 2);
    if Pos.Y <= ArrowHeight then
    begin
      { up button}
      PButton := 1;
      exit;
    end;

    if Pos.Y >= R.Bottom - ArrowHeight then
    begin
      { down button}
      PButton := 2;
      exit;
    end;
  end;

  Pos.Y := Pos.Y + GetOffset(True);
  ClientToScreen(Handle, Pos);
  for i := Offset to Count - 1 do
  begin
    GetMenuItemRect(0, FMenu, i, LItemRect);
    if PtInRect (LItemRect, Pos) then
    begin
      Result := i;
      exit;
    end;
  end;
  if Result = -1 then
    Result := -1;
end;

function TSysPopupStyleHook.GetMousePos(): TPoint;
begin
  Result := Mouse.CursorPos;
  ScreenToClient(Handle, Result);
end;

procedure TSysPopupStyleHook.WndProc(var Message: TMessage);
var
  i: integer;
  TopWin: HWND;
  TopCntrl: TControl;
  LButton: Byte;
  LInitPos: TPoint;
  Message2: TMessage;
  LSwap: Boolean;

begin
//OutputDebugString(PChar(FormatDateTime('hh:nn:ss.zzz', Now)+' Msg = ' + IntToHex(Message.Msg, 4) + ' wParam = ' + IntToHex(Message.wParam, 8) + ' LParam = ' + IntToHex(Message.lParam, 8)));
//  AddToLog(Message);
//Message.Result := CallDefaultProc(Message);
//Exit;
{

  case Message.Msg of
            WM_KEYFIRST..WM_KEYLAST:
            begin
              FEnterWithKeyboard := True;
            end;
  end;
}
  case Message.Msg of
    MN_SELECTITEM, WM_PRINT:
      begin
        if (not OverridePaint) or (not OverridePaintNC) then
        begin
          Message.Result := CallDefaultProc(Message);
          Exit; { Do not Dispatch . }
        end;
      end;

    WM_PAINT:
      begin
        if not OverridePaint then
        begin
          Message.Result := CallDefaultProc(Message);
          Exit;
        end;
        SetRedraw(False);
        Message.Result := CallDefaultProc(Message);
        SetRedraw(True);
        Exit; { Do not Dispatch . }
      end;

    WM_WINDOWPOSCHANGED:
      begin
        if (not OverridePaint) or (not OverridePaintNC) then
        begin
          Message.Result := CallDefaultProc(Message);
          Exit;
        end;
        SetTimer(Handle, $93, 100, nil);
      end;

    WM_TIMER:
      begin
        if (FItemsPainted) and (Message.WParam = $93) then
        begin
          { If PopupMenu is droped from MainMenu ,
            MainMenu will send WM_KEYDOWN message
            to the PopupMenu that cause the PopupMenu
            to paint the first item as a hot item instead of
            a normal item .
            I use a timer to solve this problem .
          }
          FPaintFirstItemFromMenu := True;
          KillTimer(Handle, $93);
        end;
        if Message.WParam = $201 then
        { down menu }
        begin
          LSwap := GetSystemMetrics(SM_SWAPBUTTON) <> 0;
          if (LSwap and ((GetKeyState(VK_RBUTTON) and $80) <> 0)) or (not(LSwap) and ((GetKeyState(VK_LBUTTON) and $80) <> 0)) then
          begin
            if not ItemIsVisible(Count - 1) then
            begin
              Offset := Offset + 1;
              RefreshMenu();
            end
            else
              KillTimer(Handle, $201);
          end
          else
            KillTimer(Handle, $201);
        end;
        if Message.WParam = $202 then
        { up menu }
        begin
          LSwap := GetSystemMetrics(SM_SWAPBUTTON) <> 0;
          if (LSwap and ((GetKeyState(VK_RBUTTON) and $80) <> 0)) or (not(LSwap) and ((GetKeyState(VK_LBUTTON) and $80) <> 0)) then
          begin
            if Offset > 0 then
            begin
              Offset := Offset - 1;
              RefreshMenu();
            end
            else
              KillTimer(Handle, $202);
          end
          else
            KillTimer(Handle, $202);
        end;
      end;

    MN_BUTTONDOWN_UP, MN_DBLCLK:
      begin
        { we should calc item/button pressed with mouse position }
        LInitPos.X := 0;
        LInitPos.Y := 0;
        FKeyIndex := GetItemClicked(LButton, LInitPos);
        case LButton of
          0:
          begin
            { Click on MenuItem}
            if FKeyIndex = -1 then
            begin
              Message.Result := 0;
              exit;
            end;
            Message2.Msg := MN_SELECTITEM;
            Message2.wParam := FKeyIndex;
            Message2.lParam := 0;
            Message2.Result := 0;
            CallDefaultProc(Message2);

            Message2.Msg := WM_KEYDOWN;
            Message2.wParam := VK_RETURN;
            CallDefaultProc(Message2);

            Message2.Msg := WM_KEYUP;
            CallDefaultProc(Message2);
            exit;
          end;
          1:
          begin
            { Scroll up menu }
            if Offset > 0 then
            begin
              FKeyIndex := -1;
              Offset := Offset - 1;
              RefreshMenu();
              if FKeyIndex <> FPreviousHotItemIndex then
                SendMessage(Handle, MN_SELECTITEM, FKeyIndex, 0);
              Message.Result := 0;
              SetTimer(Handle, $202, 150, nil);
              exit;
            end
            else
            begin
              Message.Result := 0;
              exit;
            end;
          end;
          2:
          begin
            { Scroll down }
            if not ItemIsVisible(Count - 1) then
            begin
              Offset := Offset + 1;
              FKeyIndex := -1;
              RefreshMenu();
              if FKeyIndex <> FPreviousHotItemIndex then
                SendMessage(Handle, MN_SELECTITEM, FKeyIndex, 0);
              SetTimer(Handle, $201, 150, nil);
              Message.Result := 0;
              exit;
            end
            else
            begin
              Message.Result := 0;
              exit;
            end;
          end;
        end;
      end;

    WM_KEYDOWN:
      begin
        if (not OverridePaint) or (not OverridePaintNC) then
        begin
          Message.Result := CallDefaultProc(Message);
          Exit;
        end;

        FEnterWithKeyboard := True;

        FMenu := GetMenuFromHandle(Handle);
        if FPreviousHotItemIndex <> -1 then
          FKeyIndex := FPreviousHotItemIndex;

        case Message.WParam of

          VK_DOWN:
            if FPaintFirstItemFromMenu then
            begin
              if FKeyIndex >= GetMenuItemCount(Menu) - 1 then
                FKeyIndex := -1;

              Inc(FKeyIndex);
              { If the Current Item is Separator then
                find the next valid item .
              }
              if IsItemSeparator(Menu, FKeyIndex) then
                for i := FKeyIndex to GetMenuItemCount(Menu) - 1 do
                  if (not IsItemSeparator(Menu, i)) then
                  begin
                    FKeyIndex := i;
                    Break;
                  end;
              if not ItemIsVisible(FKeyIndex) then
              begin
                if FKeyIndex <= 0 then
                begin
                  if Offset <> 0 then
                  begin
                    Offset := 0;
                  end;
                end
                else
                begin
                  if Offset >= GetMenuItemCount(Menu) then
                    Offset := GetMenuItemCount(Menu) - 1
                  else
                  begin
                    Offset := Offset + 1;
                    while not ItemIsVisible(FKeyIndex) do
                      Offset := Offset + 1;
                  end;
                end;
                RefreshMenu();
              end;

              SendMessage(Handle, MN_SELECTITEM, FKeyIndex, 0);
              Message.Result := 0;
            end;

          VK_UP:
            begin
              if (FKeyIndex <= 0) or (FKeyIndex > GetMenuItemCount(Menu)) then
                FKeyIndex := GetMenuItemCount(Menu);

              Dec(FKeyIndex);
              { If the Current Item is Separator then
                find the next valid item .
              }
              if IsItemSeparator(Menu, FKeyIndex) then
                for i := FKeyIndex downto 0 do
                  if not IsItemSeparator(Menu, i) then
                  begin
                    FKeyIndex := i;
                    Break;
                  end;
              if not ItemIsVisible(FKeyIndex) then
              begin
                if FKeyIndex <= 0 then
                begin
                  if Offset <> 0 then
                  begin
                    Offset := 0
                  end;
                end
                else
                begin
                  Offset := Offset - 1;
                  if Offset < 0 then
                  begin
                    { Calc new offset value }
                    SetMaxOffset();
                  end
                  else
                  begin
                    while not ItemIsVisible(FKeyIndex) do
                      Offset := Offset - 1;
                  end;
                end;
                RefreshMenu();
              end;

              SendMessage(Handle, MN_SELECTITEM, FKeyIndex, 0);
              Message.Result := 0;
            end;

        else
          { Calling the Default Message will cause
            the WM_PAINT Message to be Sent to the PopupMenu Window }
          Message.Result := CallDefaultProc(Message);
        end;
        Exit;
      end;

    WM_ERASEBKGND:
      begin
        if (not OverridePaint) or (not OverridePaintNC) then
        begin
          Message.Result := CallDefaultProc(Message);
          Exit;
        end;
        SendMessage(Handle, WM_PRINT, Message.WParam, Message.lParam);
        Message.Result := 1;
        Exit; { Do not Dispatch . }
      end;

    WM_PRINTCLIENT:
      begin
        if (not OverridePaint) or (not OverridePaintNC) then
        begin
          Message.Result := CallDefaultProc(Message);
          Exit;
        end;
        SendMessage(Handle, WM_PRINT, Message.WParam, Message.lParam);
        Exit;
      end;

    WM_NCCALCSIZE, WM_NCPAINT:
      begin
        if Message.Msg= WM_NCCALCSIZE then
        begin
          if TWMNCCalcSize(Message).CalcValidRects then
          begin
            FNCRect := TWMNCCalcSize(Message).CalcSize_Params.rgrc[0];
            //Message.Result := CallDefaultProc(Message);
            //LRect := TWMNCCalcSize(Message).CalcSize_Params.rgrc0;
            //OutputDebugString(PChar(Format('LRect.Height %d WParam %d', [FNCRect.Height, Message.WParam])));
          end;
        end;

        if (not OverridePaint) or (not OverridePaintNC) then
        begin
          Message.Result := CallDefaultProc(Message);
          Exit;
        end;
        if not StyleServicesEnabled then
        begin
          Handled := False;
          Exit;
        end;
        Exit; { Do not Dispatch . }
      end;

    WM_DESTROY:
      begin
        TopWin := GetForegroundWindow;
        if TopWin > 0 then
        begin
          { The parent window that host menu should be repained !! }
          if IsVCLControl(TopWin) then
          begin
            TopCntrl := FindControl(TopWin);
            if Assigned(TopCntrl) then
            begin
              {
                Must use TControl.Refresh to allow invalidating
                others no TWinControl !
              }
              TopCntrl.Refresh;
            end;
          end
          else if IsControlHooked(TopWin) then
          begin
            // AddToLog(IntToStr(TopWin));
            InvalidateRect(TopWin, nil, False);
            UpdateWindow(TopWin);
          end;
        end;
        FVCLMenuItems := nil;
        SetLength(SubMenuItemInfoArray, 0);
        SubMenuItemInfoArray := nil;
        Handled := False;
      end;

    //
    // WM_NCDESTROY :
    // begin
    // end;

  end;
  inherited;
end;

{ TSysPopupItem }

constructor TSysPopupStyleHook.TSysPopupItem.Create(SysPopupStyleHook: TSysPopupStyleHook; SysParent: TSysControl; const Index: integer; const Menu: HMENU);
begin
  inherited Create;
  FSysPopupStyleHook := SysPopupStyleHook;
  FMenu := Menu;
  FHandle := SysParent.Handle;
  FSysParent := SysParent;
  FIndex := Index;
end;

destructor TSysPopupStyleHook.TSysPopupItem.Destroy;
begin
  inherited;
end;

function TSysPopupStyleHook.TSysPopupItem.GetItemBitmap: HBITMAP;
var
  pMenuItemInfo: TMenuItemInfo;
begin
  Result := 0;
  FillChar(pMenuItemInfo, sizeof(pMenuItemInfo), Char(0));
  pMenuItemInfo.cbSize := sizeof(TMenuItemInfo);
  pMenuItemInfo.fMask := MIIM_CHECKMARKS or MIIM_BITMAP;
  if GetMenuItemInfo(FMenu, FIndex, True, pMenuItemInfo) then
  begin
    Result := pMenuItemInfo.hbmpItem;
    if Result = 0 then
      Result := pMenuItemInfo.hbmpUnchecked;
  end;
end;

function TSysPopupStyleHook.TSysPopupItem.GetItemID: WORD;
begin
  Result := 0;
  if (FMenu > 0) and (FIndex > -1) then
    Result := GetMenuItemID(FMenu, FIndex);
end;

function TSysPopupStyleHook.TSysPopupItem.GetItemRect: TRect;
begin
  Result := Rect(0, 0, 0, 0);
  if (FMenu > 0) and (FIndex > -1) then
    GetMenuItemRect(0, FMenu, FIndex, Result);
end;

function TSysPopupStyleHook.TSysPopupItem.GetItemText: String;
var
  Buffer: PChar;
  StrSize: integer;
  pMenuItemInfo: MENUITEMINFO;
begin

  if VCLItem <> nil then
  begin
    Result := VCLItem.Caption;
    Exit;
  end;

  { Note:
    The GetMenuString function has been superseded.
    Use the GetMenuItemInfo function to retrieve the menu item text.
  }

  Result := '';

  FillChar(pMenuItemInfo, SizeOf(MENUITEMINFO), Char(0));
  pMenuItemInfo.cbSize := SizeOf(MENUITEMINFO);
  pMenuItemInfo.fMask := MIIM_STRING or MIIM_FTYPE;
  pMenuItemInfo.dwTypeData := nil;
  if GetMenuItemInfo(FMenu, FIndex, True, pMenuItemInfo) then
  begin
     //Fix for shell menus on W10
    if (VCLMenuItems = nil) or (not (pMenuItemInfo.fType and MFT_OWNERDRAW = MFT_OWNERDRAW)) then
    begin
      { The Size needed for the Buffer . }
      StrSize := pMenuItemInfo.cch * 2 + 2;
      GetMem(Buffer, StrSize);
      try
        pMenuItemInfo.dwTypeData := Buffer;
        { inc cch to get the last char . }
        inc(pMenuItemInfo.cch);
        if GetMenuItemInfo(FMenu, FIndex, True, pMenuItemInfo) then
          Result := String(Buffer);
      finally
        // OutputDebugString(PChar('StrSize '+IntToStr(StrSize)));
        FreeMem(Buffer, StrSize);
      end;
      Exit;
    end
    else
    begin
      { if the item is owner draw then we need another way to get
        the item text since , when setting an item to ownerdraw windows
        will destroy the dwTypeData that hold the text . }
      FillChar(pMenuItemInfo, sizeof(MENUITEMINFO), Char(0));
      pMenuItemInfo.cbSize := sizeof(MENUITEMINFO);
      pMenuItemInfo.fMask := MIIM_DATA;
      if GetMenuItemInfo(FMenu, FIndex, True, pMenuItemInfo) then
        Result := String(PChar(pMenuItemInfo.dwItemData));
    end;
  end;
end;

function TSysPopupStyleHook.TSysPopupItem.GetVCLRealItem: TMenuItem;
var
  i: integer;
  VisibleItems: TList;
  LVCLMenuItems: TMenuItem;
begin
  {
    Return the real menu item .
    If MenuItem has the Visible property set to false
    windows will delete this item but the VCL will not delete
    the item from Items property .And thats can cause the item to be painted !
    Do not access VCLMenuItems.Items[Index] directly
    => Instead , use this one: VCLItem .
  }
  VisibleItems := nil;
  Result := nil;
  LVCLMenuItems := VCLMenuItems;
  if LVCLMenuItems <> nil then
  begin
    VisibleItems := TList.Create;
    for i := 0 to LVCLMenuItems.Count - 1 do
    begin
      if LVCLMenuItems.Items[i].Visible then
        VisibleItems.Add(LVCLMenuItems.Items[i]);
    end;
  end;
  if Assigned(VisibleItems) then
  begin
    if (VisibleItems.Count > 0) and (FIndex < VisibleItems.Count) then
      Result := VisibleItems.Items[FIndex];
    FreeAndNil(VisibleItems);
  end;
end;

function TSysPopupStyleHook.TSysPopupItem.GetVCLMenuItems: TMenuItem;
var
  i, j: integer;
  LPopupMenu: TPopupMenu;
  LForm: TCustomForm;
  LMenuItem: TMenuItem;

  function GetChildPopup(Comp: TComponent): TMenuItem;
  var
    k: integer;
  begin
    Result := nil;
    if Assigned(Comp) then
    begin
      for k := 0 to Comp.ComponentCount - 1 do
      begin

        if Comp.Components[k] is TPopupMenu then
        begin
          LPopupMenu := TPopupMenu(Comp.Components[k]);
          if LPopupMenu.Handle = FMenu then
            Exit(LPopupMenu.Items);
        end
        else if Comp.Components[k] is TMenuItem then
        begin
          LMenuItem := TMenuItem(Comp.Components[k]);
          if LMenuItem.Handle = FMenu then
            Exit(LMenuItem);
        end;

        if Comp.Components[k].ComponentCount > 0 then
          Result := GetChildPopup(Comp.Components[k]);
        if Assigned(Result) then
          Exit;
      end;
    end;
  end;

  function GetMenuItem(AMenu: TMenuItem): TMenuItem;
  var
    LMenuItem: TMenuItem;
    i: integer;
  begin
    if (AMenu.Handle = FMenu) then
      Result := AMenu
    else
    begin
      Result := nil;
      i := 0;
      while (Result = nil) and (i < AMenu.Count) do
      begin
        LMenuItem := AMenu.Items[i];
        Result := GetMenuItem(LMenuItem);
        inc(i);
      end;
    end;
  end;

begin
  Result := nil;

  for i := 0 to PopupList.Count - 1 do
    if TPopupMenu(PopupList.Items[i]).Handle = FMenu then
      Exit(TPopupMenu(PopupList.Items[i]).Items);

  for i := 0 to Screen.FormCount - 1 do
  begin
    LForm := Screen.Forms[i];
    for j := 0 to LForm.ComponentCount - 1 do
    begin

      if LForm.Components[j] is TMenuItem then
      begin
        LMenuItem := TMenuItem(LForm.Components[j]);
        Result := GetMenuItem(LMenuItem);
        if Assigned(Result) then
          Exit;
      end
      else if LForm.Components[j] is TPopupMenu then
      begin
        LPopupMenu := TPopupMenu(LForm.Components[j]);
        if LPopupMenu.Handle = FMenu then
          Exit(LPopupMenu.Items);

        Result := GetMenuItem(LPopupMenu.Items);
        if Assigned(Result) then
          Exit;
      end
      else
      begin
        Result := GetChildPopup(LForm.Components[j]);
        if Assigned(Result) then
          Exit;
      end;
    end;
  end;
end;

function TSysPopupStyleHook.TSysPopupItem.GetVCLMenuItemsFast: TMenuItem;
begin
  if Assigned(FSysPopupStyleHook.FVCLMenuItems) then
    Result := FSysPopupStyleHook.FVCLMenuItems
  else
  begin
    Result := GetVCLMenuItems;
    FSysPopupStyleHook.FVCLMenuItems := Result;
  end;
end;

function TSysPopupStyleHook.TSysPopupItem.IsItemDisabled: Boolean;
var
  pMenuItemInfo: TMenuItemInfo;
begin
  Result := False;
  FillChar(pMenuItemInfo, sizeof(pMenuItemInfo), Char(0));
  pMenuItemInfo.cbSize := sizeof(TMenuItemInfo);
  pMenuItemInfo.fMask := MIIM_STATE;
  if GetMenuItemInfo(FMenu, FIndex, True, pMenuItemInfo) then
    Result := (pMenuItemInfo.fState and MFS_DISABLED = MFS_DISABLED) or (pMenuItemInfo.fState and MF_DISABLED = MF_DISABLED) or
      (pMenuItemInfo.fState and MF_GRAYED = MF_GRAYED);
end;

function TSysPopupStyleHook.TSysPopupItem.IsItemOwnerDraw: Boolean;
var
  pMenuItemInfo: TMenuItemInfo;
begin
  Result := False;
  FillChar(pMenuItemInfo, sizeof(MENUITEMINFO), Char(0));
  pMenuItemInfo.cbSize := sizeof(MENUITEMINFO);
  pMenuItemInfo.fMask := MIIM_FTYPE;
  pMenuItemInfo.dwTypeData := nil;
  if GetMenuItemInfo(FMenu, FIndex, True, pMenuItemInfo) then
    Result := (pMenuItemInfo.fType and MFT_OWNERDRAW = MFT_OWNERDRAW);
end;

function TSysPopupStyleHook.TSysPopupItem.IsItemRadioCheck: Boolean;
var
  pMenuItemInfo: TMenuItemInfo;
begin
  Result := False;
  FillChar(pMenuItemInfo, sizeof(pMenuItemInfo), Char(0));
  pMenuItemInfo.cbSize := sizeof(TMenuItemInfo);
  pMenuItemInfo.fMask := MIIM_FTYPE;
  if GetMenuItemInfo(FMenu, FIndex, True, pMenuItemInfo) then
    Result := (pMenuItemInfo.fType and MFT_RADIOCHECK) = MFT_RADIOCHECK;
end;

function TSysPopupStyleHook.TSysPopupItem.IsItemChecked: Boolean;
var
  pMenuItemInfo: TMenuItemInfo;
begin
  Result := False;
  FillChar(pMenuItemInfo, sizeof(pMenuItemInfo), Char(0));
  pMenuItemInfo.cbSize := sizeof(TMenuItemInfo);
  pMenuItemInfo.fMask := MIIM_STATE;
  if GetMenuItemInfo(FMenu, FIndex, True, pMenuItemInfo) then
    Result := (pMenuItemInfo.fState and MFS_CHECKED) = MFS_CHECKED;
end;

function TSysPopupStyleHook.TSysPopupItem.IsItemContainsSubMenu: Boolean;
begin
  Result := (GetSubMenu(FMenu, FIndex) > 0);
end;

function TSysPopupStyleHook.TSysPopupItem.IsItemDefault: Boolean;
var
  pMenuItemInfo: TMenuItemInfo;
begin
  Result := False;
  FillChar(pMenuItemInfo, sizeof(pMenuItemInfo), Char(0));
  pMenuItemInfo.cbSize := sizeof(TMenuItemInfo);
  pMenuItemInfo.fMask := MIIM_STATE;
  if GetMenuItemInfo(FMenu, FIndex, True, pMenuItemInfo) then
    Result := (pMenuItemInfo.fState and MFS_DEFAULT) = MFS_DEFAULT;
end;

function TSysPopupStyleHook.TSysPopupItem.IsItemSeparator: Boolean;
var
  pMenuItemInfo: TMenuItemInfo;
begin
  FillChar(pMenuItemInfo, sizeof(pMenuItemInfo), Char(0));
  pMenuItemInfo.cbSize := sizeof(TMenuItemInfo);
  pMenuItemInfo.fMask := MIIM_FTYPE;
  Result := False;
  if (FIndex > -1) and (FIndex < GetMenuItemCount(FMenu) - 1) then
  begin
    if GetMenuItemInfo(FMenu, FIndex, True, pMenuItemInfo) then
      Result := (pMenuItemInfo.fType and MFT_SEPARATOR) = MFT_SEPARATOR;
  end;
end;

initialization

SubMenuItemInfoArray := nil;

{$IFDEF UseVCLStyleUtilsMenu}
{$IF CompilerVersion >= 27} // Disable XE6-XE7 menu syshooks
TStyleManager.SystemHooks := TStyleManager.SystemHooks - [shMenus];
{$IFEND CompilerVersion}
if StyleServices.Available then
  TSysStyleManager.RegisterSysStyleHook('#32768', TSysPopupStyleHook);
{$ENDIF UseVCLStyleUtilsMenu}

finalization

{$IFDEF UseVCLStyleUtilsMenu}
  TSysStyleManager.UnRegisterSysStyleHook('#32768', TSysPopupStyleHook);
{$ENDIF UseVCLStyleUtilsMenu}

end.
