Delphi控件源码

开发平台：
C++ Builder

am2000popupmenu.pas：源码内容
							
{*******************************************************}
{                                                       }
{       AnimatedMenus/2000                              }
{       TCustomPopupMenu2000 and TPopupMenu200Form      }
{                                                       }
{       Copyright (c) 1997-99 AnimatedMenus.com         }
{       All rights reserved.                            }
{                                                       }
{*******************************************************}
unit am2000popupmenu;
{$I am2000.inc}
interface
uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, StdCtrls, ExtCtrls,
  Forms, Dialogs, Buttons, ComCtrls, Menus,
  am2000options, am2000menuitem;
type
  // popup menu
  TCustomPopupMenu2000 = class(T_AM2000_PopupMenu)
  private
    FEMI2000         : TEditableMenuItem2000; // layer for comptibility with Delphi and your apps
    FSBPanelNo       : Integer;
    FStatusBar       : TStatusBar;
    FOnMenuCommand   : TNotifyEvent;
    FOnMenuClose     : TNotifyEvent;
    FFont            : TFont;
    FParentFont      : Boolean;
    FParentShowHint  : Boolean;
    FShowHint        : Boolean;
    FSystemFont      : Boolean;
    FOnCloseQuery    : TCloseQueryEvent;
    FRootItem        : TMenuItem2000;
    FOptions         : T_AM2000_Options;
    FCtl3D           : Boolean;
{$IFNDEF Delphi4OrHigher}
    FImages          : TImageList;
{$ENDIF}
    function IsFontStored: Boolean;
    function IsShowHintStored: Boolean;
    procedure SetFont(Value: TFont);
    procedure SetParentFont(Value: Boolean);
    procedure SetShowHint(Value: Boolean);
    procedure SetParentShowHint(Value: Boolean);
    procedure SetSystemFont(Value: Boolean);
    procedure SetOptions(Value: T_AM2000_Options);
  protected
    property ParentShowHint  : Boolean
      read FParentShowHint write SetParentShowHint default True;
    property ParentFont      : Boolean
      read FParentFont write SetParentFont default True;
    procedure AssignMenuItems(var DestItems: TMenuItem; var DestHandle: HMenu); virtual;
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
  public
    Form             : TForm;
    MenuItems        : TMenuItem;
    MenuHandle       : HMenu;
    property StatusBar       : TStatusBar
      read FStatusBar write FStatusBar;
    property StatusBarIndex  : Integer
      read FSBPanelNo write FSBPanelNo;
    property ShowHint        : Boolean
      read FShowHint write SetShowHint stored IsShowHintStored;
    property Options         : T_AM2000_Options
      read FOptions write SetOptions;
    property Font            : TFont
      read FFont write SetFont stored IsFontStored;
    property SystemFont      : Boolean
      read FSystemFont write SetSystemFont default True;
    property Ctl3D           : Boolean
      read FCtl3D write FCtl3D default True;
    property Items2000       : TMenuItem2000
      read FRootItem stored True;
    property OnMenuCommand   : TNotifyEvent
      read FOnMenuCommand write FOnMenuCommand;
    property OnMenuClose     : TNotifyEvent
      read FOnMenuClose write FOnMenuClose;
    property OnCloseQuery    : TCloseQueryEvent
      read FOnCloseQuery write FOnCloseQuery;
{$IFNDEF Delphi4OrHigher}
    property Images : TImageList read FImages write FImages;
{$ENDIF}
    constructor Create(AOwner: TComponent); override;
    destructor Destroy;                     override;
    procedure Popup(X, Y: Integer);         override;
    procedure SetSelectedIndex(First: Boolean);
    procedure RemoveShowHiddenFlag;
    function FormOnScreen: Boolean;
    function GetTopMostForm: TForm;
    procedure InitItems(AddEmpty: Boolean); virtual;
    function IsShortCut(var Msg: TWMKey): Boolean;
{$IFDEF Delphi4OrHigher}
    override;
{$ENDIF}
  published
    property Items   : TEditableMenuItem2000  read FEMI2000;
  end;
  // template
  TCustomPopupMenu2000Form = class(TForm)
  end;
implementation
uses
  CommCtrl, MmSystem, ShellApi, 
  am2000menubar, am2000title, am2000hintwindow, am2000utils,
  am2000const;
const
  COLOR_GRADIENTACTIVECAPTION = 27;
  COLOR_GRADIENTINACTIVECAPTION = 28;
  clGradientActiveCaption = TColor(COLOR_GRADIENTACTIVECAPTION or $80000000);
  clGradientInactiveCaption = TColor(COLOR_GRADIENTINACTIVECAPTION or $80000000);
type
  T_AM2000_PMFState = set of (fsSelectedChanged, fsMouseChanged, fsPaintMenu, fsFromBottomToTop,
    fsFromRightToLeft, fsDrawDisabled, fsIgnoreMouseMove, fsBecomingDraggable, fsAnimated,
    fsKillAnimate, fsDisabled, fsCtl3d, fsShowHidden, fsHiddenArrow, fsHiddenAsRegular,
    fsNoDrawCanvas);
  TByteArray = array [0..1024*1024] of Byte;
  PByteArray = ^TByteArray;
  TShortIntArray = array [0..1024*1024] of ShortInt;
  PShortIntArray = ^TShortIntArray;
  TPopupMenu2000Form = class(TCustomPopupMenu2000Form)
  private
    bi: TBitmapInfo;
    bits, bits0, bits1: PByteArray;
    dbits: PShortIntArray;
    Buffer, Back: TBitmap;
    FSelectedIndex, LastSelectedIndex, ItemWidth, ShortcutWidth,
      ItemHeight, DX, DY, ParentMenuIndex, CurHiddenCount, BitsSize, CurStep: Integer;
    Animation, CloseAnimation: T_AM2000_Animation;
    PopupMenu: TCustomPopupMenu2000;
    SubMenuForm, ParentMenuForm: TPopupMenu2000Form;
    Timer, ASTimer: TTimer;
    MenuHandle: HMenu;
    Options: T_AM2000_Options;
    MouseState: T_AM2000_MouseState;
    NewLeft, NewTop, NewWidth, NewHeight, MX, MY, BL: Integer;
    TimeStart: Integer;
    State: T_AM2000_PMFState;
    ToolTipWindow: T_AM2000_ToolTipWindow;
    // items rects
    FiLeft, FiWidth: Integer;
    ItemRects: TList;
    FocusItem: TMenuItem;
    procedure wmKeyDown(var Msg: TWMKeyDown);      message wm_KeyDown;
    procedure wmSysKeyDown(var Msg: TWMKeyDown);   message wm_SysKeyDown;
    procedure wmChar(var Msg: TWMChar);            message wm_Char;
    procedure cmMouseLeave(var Msg: TMessage);     message cm_MouseLeave;
    procedure wmSetFocus(var Msg: TWMSetFocus);    message wm_SetFocus;
    procedure wmActivate(var Msg: TWMActivate);    message wm_Activate;
    procedure wmMouseActivate(var Msg: TWMMouseActivate); message wm_MouseActivate;
    procedure cmShowingChanged(var Msg: TMessage); message cm_ShowingChanged;
    procedure wmShowAnimated(var Msg: TMessage);   message wm_ShowAnimated;
    procedure wmHideSilent(var Msg: TMessage);     message wm_HideSilent;
    procedure wmKillAnimation(var Msg: TMessage);  message wm_KillAnimation;
    procedure wmKillTimer(var Msg: TMessage);      message wm_KillTimer;
    procedure wmInitState(var Msg: TMessage);      message wm_InitState;
    procedure wmMouseMove(var Msg: TWMMouse);      message wm_MouseMove;
    // utilities
    procedure SetSelectedIndex(Value: Integer);
    procedure PopupMenu2000FormTimer(Sender: TObject);
    procedure SearchForOpenedMenuShortcut(var Msg: TWMKey);
    procedure DestroySubMenuForm;
    procedure CreateSubMenuForm(Menu: TPopupMenu; Handle: HMenu; Items: TMenuItem);
    procedure RebuildToolTipWindow(Recreate: Boolean);
    // bounds management
    procedure RebuildBounds;
    function GetItemRect(Index: Integer): TRect;
    function GetMenuItemHeight(const M: TMenuItem): Integer;
    function GetMenuItemHeightIndex(Index: Integer): Integer;
    function GetRealHeight: Integer; virtual;
    function GetRealWidth: Integer;  virtual;
    procedure GetOptions(Items: TMenuItem; Popup: TObject;
      var Options: T_AM2000_Options);
    procedure TimerShow(Sender: TObject);
    procedure AnimatedHide;
  protected
    procedure Paint; override;
    procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
    procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
    procedure SetZOrder(TopMost : Boolean); override;
  public
    CurMenuItem, MenuItems: TMenuItem;
    property SelectedIndex: Integer read FSelectedIndex write SetSelectedIndex;
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    function Animate: Boolean; virtual;
    procedure SilentShow;
    procedure SilentHide;
    procedure Repaint; override;
    procedure PopupSubMenuForm(SelectFirst: Boolean);
    procedure BringMenuToFront;
    function GetCurMenuItem(RaiseException: Boolean): TMenuItem;
    function GetMenuItemIndex(Index: Integer; RaiseException: Boolean): TMenuItem;
    // bounds management
    function GetIndexAt(X, Y: Integer): Integer;
  end;
  // forgot about this
  TFalseMenu = class(TComponent)
  private
{$IFDEF Delphi4OrHigher}
    FBiDiMode: TBiDiMode;
{$ENDIF}
    FItems: TMenuItem;
  end;
{ TCustomPopupMenu2000 }
constructor TCustomPopupMenu2000.Create(AOwner: TComponent);
begin
  inherited;
  FFont:= TFont.Create;
  FParentFont:= False;
  FSystemFont:= True;
  FCtl3D:= True;
  FRootItem:= TMenuItem2000.Create(Self);
  FOptions:= T_AM2000_Options.Create;
  // we don't need TMenuItem so we just destoy it
  // and create TMenuItem2000 instead of.
  TFalseMenu(Self).FItems.Free;
  TFalseMenu(Self).FItems:= FRootItem;
{$IFDEF Delphi4OrHigher}
  TFalseMenu(Self).FBiDiMode:= BiDiMode;
{$ENDIF}
  FEMI2000:= TEditableMenuItem2000.Create(Self);
  // this form will be automatically destroyed by the Owner
  if not (csDesigning in ComponentState) then
    Form:= TPopupMenu2000Form.Create(Owner);
end;
destructor TCustomPopupMenu2000.Destroy;
begin
  FFont.Free;
  FOptions.Free;
  if (csDesigning in ComponentState)
  then SendMessage(GetMnuDsgnHandle, wm_Close, 0, 0);
  inherited;
end;
procedure TCustomPopupMenu2000.Popup(X, Y: Integer);
begin
  KillActivePopupMenu2000(False, False);
  ActivePopupMenu:= Self;
  // event
  if Assigned(OnPopup)
  then OnPopup(Self);
  // init items
  InitItems(False);
  // remove hidden items
  if not (PopupComponent is TCustomMenuBar2000)
  then RemoveShowHiddenFlag;
  // bring menu to front
  Forms.TForm(Owner).BringToFront;
  with TPopupMenu2000Form(Form) do begin
    ParentMenuForm:= nil;
    AssignMenuItems(MenuItems, MenuHandle);
    // set system font
    if (PopupComponent is TCustomMenuBar2000)
    then SystemFont:= TCustomMenuBar2000(PopupComponent).SystemFont
    else SystemFont:= Self.SystemFont;
    // set animation options
    if MenuItems is TMenuItem2000
    and (TMenuItem2000(MenuItems).Options is T_AM2000_Options)
    then
      with T_AM2000_Options(TMenuItem2000(MenuItems).Options) do begin
        TPopupMenu2000Form(Form).Animation:= Animation;
        TPopupMenu2000Form(Form).CloseAnimation:= CloseAnimation;
      end;
    PopupMenu:= Self;
    Include(State, fsSelectedChanged);
    // show menu
    if (not IsWindowEnabled(Handle))
    then EnableWindow(Handle, True);
    SetBounds(X, Y, 0, 0);
    BringMenuToFront;
    // animation
    try
      if Animate then Exit;
    except
    end;
    SilentHide;
    if ActivePopupMenu = Self
    then ActivePopupMenu:= nil;
  end;
end;
procedure TCustomPopupMenu2000.AssignMenuItems(var DestItems: TMenuItem; var DestHandle: HMenu);
  // assigns menu items to TCustomPopupMenu2000Form
begin
  if MenuItems <> nil
  then DestItems:= Self.MenuItems
  else DestItems:= Self.Items2000;
  if MenuHandle <> 0
  then DestHandle:= Self.MenuHandle
  else DestHandle:= DestItems.Handle;
end;
function TCustomPopupMenu2000.FormOnScreen: Boolean;
var
  R: TRect;
begin
  Result:= (Form <> nil)
    and (GetClientRect(Form.Handle, R))
    and (R.Top <> R.Bottom)
    and (R.Left <> R.Right);
end;
function TCustomPopupMenu2000.GetTopMostForm: TForm;
begin
  Result:= Form;
  while Assigned(TPopupMenu2000Form(Result).SubMenuForm)
  do Result:= TPopupMenu2000Form(Result).SubMenuForm;
end;
procedure TCustomPopupMenu2000.SetSelectedIndex(First: Boolean);
begin
  if Form <> nil
  then
    with TPopupMenu2000Form(Form) do begin
      if First
      then
        FSelectedIndex:= 0
      else
        FSelectedIndex:= itNothing;
        
      if FormOnScreen then Paint;
    end;
end;
function TCustomPopupMenu2000.IsFontStored: Boolean;
begin
  Result:= not (FParentFont or FSystemFont);
end;
function TCustomPopupMenu2000.IsShowHintStored: Boolean;
begin
  Result:= not FParentShowHint;
end;
procedure TCustomPopupMenu2000.SetFont(Value: TFont);
begin
  FFont.Assign(Value);
end;
procedure TCustomPopupMenu2000.SetParentFont(Value: Boolean);
begin
  FParentFont:= Value;
  if Value then FSystemFont:= False;
end;
procedure TCustomPopupMenu2000.SetSystemFont(Value: Boolean);
begin
  FSystemFont:= Value;
  if Value then FParentFont:= False;
end;
procedure TCustomPopupMenu2000.SetShowHint(Value: Boolean);
begin
  if FShowHint <> Value then begin
    FShowHint:= Value;
    FParentShowHint:= False;
  end;
end;
procedure TCustomPopupMenu2000.SetParentShowHint(Value: Boolean);
begin
  if FParentShowHint <> Value then
    FParentShowHint:= Value;
  if FParentShowHint then
    if Owner is TControl
    then FShowHint:= TControl(Owner).ShowHint
    else FShowHint:= False;
end;
procedure TCustomPopupMenu2000.SetOptions(Value: T_AM2000_Options);
begin
  FOptions.Assign(Value);
end;
procedure TCustomPopupMenu2000.Notification(AComponent: TComponent;
  Operation: TOperation);
begin
  inherited;
  if (Operation = opRemove) then begin
{$IFNDEF Delphi4OrHigher}
    if (AComponent = FImages) then FImages:= nil;
{$ENDIF}
    if (AComponent = FStatusBar) then FStatusBar:= nil;
  end;
end;
procedure TCustomPopupMenu2000.InitItems(AddEmpty: Boolean);
begin
  if (Items.Count = 0)
  and (MenuItems = nil)
  and (MenuHandle = 0)
  then Items.Add(NewItem('(Empty)', 0, False, False, nil, 0, ''));
end;
procedure TCustomPopupMenu2000.RemoveShowHiddenFlag;
begin
  with TPopupMenu2000Form(Form) do
    if not (fsBecomingDraggable in State) then begin
      Exclude(State, fsShowHidden);
      Exclude(State, fsHiddenAsRegular);
    end;
  if not (mfHiddenAsRegular in Options.Flags)
  then Options.Flags:= Options.Flags - [mfHiddenIsVisible];
end;
function TCustomPopupMenu2000.IsShortCut(var Msg: TWMKey): Boolean;
begin
  Result:= IsShortCutEx(Msg, Items2000, csDesigning in ComponentState);
end;
{ TPopupMenu2000Form }
constructor TPopupMenu2000Form.Create(AOwner: TComponent);
begin
  inherited CreateNew(AOwner {$IFDEF VER93}, 0{$ENDIF});
  // own initializaton
  FSelectedIndex:= itNothing;
  CurHiddenCount:= 0;
  LastSelectedIndex:= itNothing;
  Animation:=  anVSlide;
  CloseAnimation:= anVSlide;
  BorderStyle:= bsNone;
  FormStyle:= fsStayOnTop;
  Position:= poDesigned;
  // init timers
  Timer:= TTimer.Create(Self);
  Timer.Enabled:= False;
  Timer.Interval:= 250;
  Timer.OnTimer:= PopupMenu2000FormTimer;
  ASTimer:= TTimer.Create(Self);
  ASTimer.Enabled:= False;
  ASTimer.Interval:= 2000;
  ASTimer.OnTimer:= TimerShow;
  Buffer:= TBitmap.Create;
  Buffer.Canvas.Font.Assign(Font);
  Back:= TBitmap.Create;
  ItemRects:= TList.Create;
  SetBounds(0, 0, 0, 0);
  InstallGMHooks;
end;
destructor TPopupMenu2000Form.Destroy;
begin
  MenuItems:= nil;
  Back.Free;
  Buffer.Free;
  Options.Free;
  ItemRects.Free;
  // free bits
  if bits <> nil then Freemem(bits);
  if bits0 <> nil then Freemem(bits0);
  if bits1 <> nil then Freemem(bits1);
  if dbits <> nil then Freemem(dbits);
  ToolTipWindow.Free;
  RemoveGMHooks;
  // this checking is necessary when submenu going to be killed
  // by MainForm (Owner property), not by ParenTCustomPopupMenu2000
  if (ParentMenuForm <> nil)
  and (ParentMenuForm.SubMenuForm = Self) then
    ParentMenuForm.SubMenuForm:= nil;
  if (SubMenuForm <> nil)
  then SubMenuForm.Release;
  inherited Destroy;
end;
{ Properties }
function TPopupMenu2000Form.GetRealHeight: Integer;
begin
  Result:= GetItemRect(ItemRects.Count -1).Bottom +
    Options.Margins.Bottom;
  // options
  with Options do begin
    if (BackgroundDisplay = bdExpand)
    and (Result < Background.Height)
    then Result:= Background.Height;
  end;
  // hidden arrow
  if fsHiddenArrow in State
  then Inc(Result, 19);
  // ctl3d
  if (BorderStyle = bsNone)
  and (fsCtl3d in State)
  then Inc(Result, 2*Options.Margins.Border);
end;
function TPopupMenu2000Form.GetRealWidth: Integer;
begin
  Result:= GetItemRect(0).Right;
  // options
  with Options do
    if (BackgroundDisplay = bdExpand)
    and (Result < Background.Width)
    then Result:= Background.Width;
  // ctl3d
  if (BorderStyle = bsNone)
//  and (fsCtl3d in State)
  then Inc(Result, Options.Margins.Border * 2);
end;
function TPopupMenu2000Form.GetIndexAt(X, Y: Integer): Integer;
var
  I, H: Integer;
  P: TPoint;
begin
  P:= Point(X, Y);
  H:= Options.Margins.Top;
  if (BorderStyle = bsNone)
  then
    if (fsCtl3D in State)
    then Inc(H, Options.Margins.Border +2)
    else Inc(H, Options.Margins.Border);
  Result:= itNothing;
  if (MenuHandle = 0)
  or (Y <= H)
  then Exit;
  // is title visible?
  with Options.Title do
    if (ParentMenuForm = nil)
    and Visible
    and (((Align = atLeft) and (X <= Width))
    or   ((Align = atRight) and (X >= Buffer.Width - Width)))
    then Exit;
  // is menu draggable?
  if (Options.Draggable)
  and (BorderStyle = bsNone)
  and (Y <= 11)
  then begin
    Result:= itDragPane;
    Exit;
  end;
  // count all menu items
  for I:= 0 to ItemRects.Count -1 do
    if PtInRect(GetItemRect(I), P)
    then begin
      Result:= I;
      Exit;
    end;
  // hidden arrow?
  if (fsHiddenArrow in State)
  and PtInRect(Rect(3, Buffer.Height -16, Buffer.Width -3, Buffer.Height -3), P)
  then Result:= itHiddenArrow;
end;
procedure TPopupMenu2000Form.SetSelectedIndex(Value: Integer);
var
  Direction: Integer;
  M: TMenuItem;
begin
  if (Value <> SelectedIndex) then begin
    if Value > FSelectedIndex then Direction:= 1
                              else Direction:= -1;
    LastSelectedIndex:= FSelectedIndex;
    FSelectedIndex:= Value;
    Include(State, fsSelectedChanged);
    if MenuHandle = 0 then Exit;
    mii.fMask:= miim_Type + miim_State;
    repeat
      // in case if LastSelectedItem = itNothing
      if (FSelectedIndex = LastSelectedIndex) then Break;
      if FSelectedIndex < 0 then FSelectedIndex:= ItemRects.Count -1;
      if FSelectedIndex >= ItemRects.Count then begin
        FSelectedIndex:= itNothing;
        // show hidden menu items
        if fsHiddenArrow in State then begin
          ASTimer.Enabled:= False;
          Include(State, fsShowHidden);
          SilentHide;
          Animate;
          Exit;
        end;
      end;
      // no enabled items available
      if (FSelectedIndex = LastSelectedIndex)
      then Break;
      // try to find ordinal menu item
      M:= GetMenuItemIndex(FSelectedIndex, False);
      if (M <> nil)
      and (M.Caption <> '-')
      and ((M.Enabled) or (not (mfNoHighDisabled in Options.Flags)))
      then Break;
      // Win32 menu item
      if (M = nil) then begin
        mii.dwTypeData:= Z;
        mii.cch:= SizeOf(Z) -1;
        if GetMenuItemInfo(MenuHandle, FSelectedIndex, True, mii)
        and (mii.fType and mft_Separator = 0)
        and (mii.fState and (mfs_Grayed + mfs_Disabled) = 0)
        then Break;
      end;
      Inc(FSelectedIndex, Direction);
    until False;
    Include(State, fsDrawDisabled);
    Paint;
    CheckShowHint(GetCurMenuItem(False), False, Self);
    // set context
    if (CurMenuItem <> nil)
    then HelpContext:= CurMenuItem.HelpContext;
  end;
end;
procedure TPopupMenu2000Form.GetOptions(Items: TMenuItem; Popup: TObject; var Options: T_AM2000_Options);
  // returns options for the current submenu
begin
  Options.Free;
  Options:= T_AM2000_Options.Create;
  // assign parent options
  if (Popup is TCustomPopupMenu2000)
  then Options.Assign(TCustomPopupMenu2000(Popup).Options);
  // title cannot be inherited
  if ParentMenuForm <> nil
  then Options.Title.Visible:= False;
  // assign current options
  if (Items is TMenuItem2000)
  and (not TMenuItem2000(Items).Options.IsDefault)
  then Options.Assign(TMenuItem2000(Items).Options);
end;
{ Events }
procedure TPopupMenu2000Form.WMActivate(var Msg: TWMActivate);
var
  F: Forms.TForm;
begin
  if (Msg.Active = wa_Active)
  and (Owner is Forms.TForm)
  then begin
    F:= Forms.TForm(Owner);
    while (F.FormStyle = fsMdiChild)
    and (F.Owner is Forms.TForm)
    do F:= Forms.TForm(F.Owner);
    if (F is Forms.TForm)
    and (F.Visible)
    and not (csDestroying in F.ComponentState)
    then SendMessage(F.Handle, wm_NCActivate, 1, 0);
  end
  else
    inherited;
end;
// many thanks to Jordan Russell again!...
procedure TPopupMenu2000Form.WMMouseActivate(var Msg: TWMMouseActivate);
begin
  Msg.Result:= ma_NoActivate;
  if (Owner is Forms.TForm) then
    SetActiveWindow(Forms.TForm(Owner).Handle);
end;
procedure TPopupMenu2000Form.CMMouseLeave(var Msg: TMessage);
begin
  inherited;
  MouseState:= [];
  if (fsAnimated in State)
  or (fsDisabled in State)
  then Exit;
  // no menu or no submenu
  if not HasSubMenu(GetCurMenuItem(False))
  then begin
    LastSelectedIndex:= FSelectedIndex;
    FSelectedIndex:= itNothing;
    Include(State, fsSelectedChanged);
    Paint;
  end;
  // clear status bar
  SetStatusBarText('');
end;
procedure TPopupMenu2000Form.WMSetFocus(var Msg: TWMSetFocus);
begin
  if (fsAnimated in State)
  and (Owner is Forms.TForm)
  and (Forms.TForm(Owner).Visible)
  then Forms.TForm(Owner).SetFocus
  else inherited;
end;
procedure TPopupMenu2000Form.CMShowingChanged(var Msg: TMessage);
begin
  // Skip Application.UpdateVisible
  // that shows annoying 'application icon' on taskbar
  if Showing
  then begin
    ShowWindow(Handle, sw_ShowNA);
    SetWindowPos(Handle, hwnd_Top, Left, Top, Width, Height, FormFlags);
  end
  else
    ShowWindow(Handle, sw_Hide);
end;
procedure TPopupMenu2000Form.MouseDown;
var
  I, MX, MY: Integer;
begin
  if ssLeft  in Shift then Include(MouseState, msLeftButton);
  if ssRight in Shift then Include(MouseState, msRightButton);
  Include(State, fsMouseChanged);
//  BringMenuToFront;
  // hide tooltip
  if (ToolTipWindow <> nil)
  then ToolTipWindow.Deactivate;
  // click on dragpane
  I:= GetIndexAt(X, Y);
  if (Options.Draggable)
  and (I = itDragPane)
  and (Button = mbLeft)
  then begin
    Include(State, fsBecomingDraggable);
    Include(State, fsShowHidden);
    Include(State, fsHiddenAsRegular);
    // Draggable pane clicked!
    if Options.Caption <> ''
    then Caption:= Options.Caption
    else
    if MenuItems.Caption <> ''
    then Caption:= StripAmpersands(MenuItems.Caption)
    else Caption:= 'AM/2000 Menu';
    // set window properties
    BorderStyle:= bsToolWindow;
    // cancel ParentMenuForm
    if ParentMenuForm <> nil then begin
      ParentMenuForm.SubMenuForm:= nil;
      ParentMenuForm:= nil;
    end;
    // hide previous floating menu
    for I:= 0 to FloatingMenusList.Count -1 do
      with TPopupMenu2000Form(FloatingMenusList[I]) do
        if MenuItems = Self.MenuItems then begin
          FloatingMenusList.Delete(I);
          Close;
          Break;
        end;
    FloatingMenusList.Add(Self);
    // rebuild bounds
    RebuildBounds;
    MX:= GetRealWidth;
    MY:= GetRealHeight;
    if SystemParametersInfo(spi_GetNonClientMetrics, 0, @NonClientMetrics, 0)
    then Inc(MY, Integer(NonClientMetrics.iCaptionHeight) +3);
    SetBounds(Left, Top, MX, MY);
    Buffer.Width:= MX;
    Buffer.Height:= MY;
    Buffer.FreeImage;
    // paint menu
    Paint;
    Show;
    Refresh;
    // tooltip window
    RebuildToolTipWindow(True);
    // remove menu
    KillActivePopupMenu2000(True, False);
    SendMessage(Handle, WM_SysCommand, $F012, 0);  // system message
    Exclude(State, fsBecomingDraggable);
  end
  else
    Paint;
end;
procedure TPopupMenu2000Form.MouseUp;
var
  wID: Integer;
  MI: TMenuItem;
  CanClose: Boolean;
  P: TPoint;
  procedure CheckHiddenSeparator(Index, Delta: Integer);
    // if a separator exists at this Index and it's hidden
    // then show it 
  var
    M1: TMenuItem;
    MS: TMenuItem2000;
    F: Boolean;
  begin
    F:= fsShowHidden in State;
    if not F then Include(State, fsShowHidden);
    Inc(Index, Delta);
    M1:= GetMenuItemIndex(Index + Delta, False);
    if (M1 is TMenuItem2000)
    and (M1.Caption = '-')
    and (TMenuItem2000(M1).Hidden)
    then begin
      MS:= TMenuItem2000(M1);
      // now check for the next not hidden menu item
      // to prevent duplicating separators
      repeat
        Inc(Index, Delta);
        M1:= GetMenuItemIndex(Index, False);
        if ((not (M1 is TMenuItem2000))
        or (not TMenuItem2000(M1).Hidden))
        then begin
          if (M1 <> nil)
          and (M1.Caption = '-')
          then MS:= nil;
          Break;
        end;
      until M1 = nil;
      if MS <> nil then MS.Hidden:= False;
    end;
    if not F then Exclude(State, fsShowHidden);
  end;
begin
  if not (ssLeft  in Shift) then Exclude(MouseState, msLeftButton);
  if not (ssRight in Shift) then Exclude(MouseState, msRightButton);
  Include(State, fsMouseChanged);
  if (fsAnimated in State) or (fsKillAnimate in State) then Exit;
  // if hidden arrow is pressed
  if SelectedIndex = itHiddenArrow then begin
    ASTimer.Enabled:= False;
    Include(State, fsShowHidden);
    SilentHide;
    Animate;
    Exit;
  end;
  // nothing is selected
  if SelectedIndex = itNothing then begin
    Paint;
    Exit;
  end;
  // popup context menu
  MI:= GetCurMenuItem(False);
  if (Button = mbRight)
  and (MI <> nil)
  and (MI is TMenuItem2000)
  and (TMenuItem2000(MI).PopupMenu <> nil)
  then
    with TMenuItem2000(MI) do begin
      Include(State, fsDisabled);
      DestroySubMenuForm;
      // on popup event
      if Assigned(PopupMenu.OnPopup)
      then PopupMenu.OnPopup(MI);
      // create context menu as submenu
      CreateSubMenuForm(PopupMenu, PopupMenu.Items.Handle, PopupMenu.Items);
      PopupMenu.PopupComponent:= MI;
      SubMenuForm.Animation:= Self.Options.Animation;
      // show context menu
      GetCursorPos(P);
      SubMenuForm.SetBounds(P.X, P.Y, 0, 0);
      SubMenuForm.Animate;
      Exit;
    end;
  // clear status bar
  SetStatusBarText('');
  if Assigned(SubMenuForm) then begin
    Exclude(State, fsDisabled);
    PopupSubMenuForm(False);
    Exit;
  end;
  CanClose:= True;
  if (MI <> nil)
  and (MenuItems.IndexOf(MI) <> -1)
  then begin
    // ordinary menu item
    if HasSubmenu(MI) then begin
      PopupSubMenuForm(False);
      Exit;
    end;
    if (not MI.Enabled) or (MI.Caption = '-') then Exit;
    // is editbox
    if (MI is TMenuItem2000)
    and (TMenuItem2000(MI).Control = ctlEditbox)
    then begin
      MI.Click;
      Include(State, fsDisabled);
      FocusItem:= MI;
      TMenuItem2000(MI).AsEdit.BeginEdit(X, Y);
      Exit;
    end;
    // other stuffs
    Timer.Enabled:= False;
    if Assigned(PopupMenu.OnCloseQuery)
    then PopupMenu.OnCloseQuery(MI, CanClose);
    if CanClose then begin
      KillActivePopupMenu2000(True, True);
      if ActiveMenuBar <> nil
      then ActiveMenuBar.HideActiveItem;
      FullShowCaret;
      sndPlaySound(PChar(MenuCommandSound), snd_Async + snd_NoDefault + snd_NoStop);
    end;
    if (MI is TMenuItem2000)
    and (TMenuItem2000(MI).Hidden)
    and (not (mfNoChangeHidden in Options.Flags))
    then begin
      TMenuItem2000(MI).Hidden:= False;
      // and show separators
      CheckHiddenSeparator(LastSelectedIndex, -1);
      CheckHiddenSeparator(LastSelectedIndex, 1);
    end;
    if Assigned(PopupMenu.OnMenuCommand)
    then PopupMenu.OnMenuCommand(MI);
    // set item index for button array
    if (MI is TMenuItem2000)
    and (TMenuItem2000(MI).Control = ctlButtonArray)
    then
      with TMenuItem2000(MI).AsButtonArray do
        ItemIndex:= LastItemIndex;
    // Click
    MI.Click;
  end
  else begin
    mii.fMask:= miim_Type + miim_ID + miim_Submenu;
    mii.dwTypeData:= Z;
    mii.cch:= SizeOf(Z) -1;
    if (not GetMenuItemInfo(MenuHandle, SelectedIndex + CurHiddenCount, True, mii))
    or (mii.fType and mft_Separator <> 0)
    or (mii.fState and mfs_Disabled <> 0)
    then Exit;
    wID:= mii.wID;
    Timer.Enabled:= False;
    if Assigned(PopupMenu.OnCloseQuery)
    then PopupMenu.OnCloseQuery(MI, CanClose);
    if CanClose then begin
      KillActivePopupMenu2000(True, True);
      if ActiveMenuBar <> nil
      then ActiveMenuBar.HideActiveItem;
      SendMessage(Forms.TForm(Owner).Handle, wm_NCActivate, 1, 0);
      FullShowCaret;
      sndPlaySound(PChar(MenuCommandSound), snd_Async + snd_NoDefault + snd_NoStop);
    end;
    if Assigned(PopupMenu.OnMenuCommand)
    then PopupMenu.OnMenuCommand(nil);
    PostMessage(Forms.TForm(Owner).Handle, wm_Command, wID, 0);
  end;
  // show must go on
  if (not CanClose)
  then begin
    Paint;
    Timer.Enabled:= True;
    if (ToolTipWindow <> nil)
    then ToolTipWindow.Activate;
  end;
end;
procedure TPopupMenu2000Form.wmMouseMove(var Msg: TWMMouse);
begin
  inherited;
  // enable tooltip
  if (ToolTipWindow <> nil) then begin
    ToolTipWindow.Activate;
    ToolTipWindow.RelayMouseMove(Msg.Pos);
  end;
end;
procedure TPopupMenu2000Form.MouseMove(Shift: TShiftState; X, Y: Integer);
const
  LastX: Integer = 0;
  LastY: Integer = 0;
var
  R: TRect;
  I, L: Integer;
begin
  Include(MouseState, msMouseOver);
  if ssLeft  in Shift
  then Include(MouseState, msLeftButton)
  else Exclude(MouseState, msLeftButton);
  if ssRight in Shift
  then Include(MouseState, msRightButton)
  else Exclude(MouseState, msRightButton);
  
  // change mouse cursor
  if (GetCurMenuItem(False) is TMenuItem2000)
  and (TMenuItem2000(CurMenuItem).Control = ctlEditbox)
  then begin
    if (BorderStyle = bsNone)
    then
      if (fsCtl3D in State)
      then L:= Options.Margins.Border +2
      else L:= Options.Margins.Border
    else
      L:= 0;
    Inc(L, AmpTextWidth(Buffer.Canvas, CurMenuItem.Caption) +5);
    R:= GetItemRect(FSelectedIndex);
    if R.Left < L then R.Left:= L;
    InflateRect(R, 0, -2);
    if PtInRect(R, Point(X, Y))
    then
      Cursor:= crIBeam
    else
      if Cursor <> crDefault
      then Cursor:= crDefault;
  end
  else
    if Cursor <> crDefault
    then Cursor:= crDefault;
  // ignore some little movements
  if (fsAnimated in State)
  or (fsKillAnimate in State)
  or (fsDisabled in State)
//  or ((Abs(X - LastX) <= 2)
//  and (Abs(Y - LastY) <= 2))
  then Exit;
  LastX:= X;
  LastY:= Y;
  if fsIgnoreMouseMove in State then begin
    Exclude(State, fsIgnoreMouseMove);
    Exit;
  end;
  Timer.Enabled:= False;
  // set parentmenuform highlight
  if (ParentMenuForm <> nil)
  and (not (fsDisabled in ParentMenuForm.State))
  and (ParentMenuForm.FSelectedIndex <> ParentMenuIndex)
  then
    with ParentMenuForm do begin
      LastSelectedIndex:= FSelectedIndex;
      FSelectedIndex:= Self.ParentMenuIndex;
      Include(State, fsSelectedChanged);
      Exclude(State, fsDrawDisabled);
      Paint;
    end;
  // set highlight
  I:= GetIndexAt(X, Y);
  if I <> SelectedIndex then begin
    LastSelectedIndex:= FSelectedIndex;
    FSelectedIndex:= I;
    Include(State, fsSelectedChanged);
    Exclude(State, fsDrawDisabled);
    Paint;
    // show menu item hint
    SetStatusBarText('');
    CheckShowHint(GetCurMenuItem(False), True, Self);
    // is it hidden arrow?
    if (SelectedIndex = itHiddenArrow) then begin
      ASTimer.Enabled:= False;
      ASTimer.Enabled:= True;
    end;
  end
  else
    if (GetCurMenuItem(False) <> nil)
    and (CurMenuItem is TMenuItem2000)
    and (TMenuItem2000(CurMenuItem).Control = ctlButtonArray)
    then
      with TMenuItem2000(CurMenuItem), AsButtonArray do
        if GetIndexAt(X, Y) <> LastItemIndex
        then begin
          Paint;
          CheckShowHint(GetCurMenuItem(False), True, Self);
        end;
  Timer.Enabled:= True;
end;
procedure TPopupMenu2000Form.SearchForOpenedMenuShortcut(var Msg: TWMKey);
  // just a symbol key - seeking for menu item
var
  I: Integer;
  M: TMenuItem;
  S: String;
  UseFirstLetter: Boolean;
begin
  UseFirstLetter:= True;
  repeat
    UseFirstLetter:= not UseFirstLetter;
    for I:= 0 to ItemRects.Count -1 do begin
      M:= GetMenuItemIndex(I, False);
      if (M = nil) then begin
        mii.fMask:= miim_ID + miim_Type + miim_State;
        mii.dwTypeData:= @Z;
        mii.cch:= SizeOf(Z) -1;
        if (not GetMenuItemInfo(MenuHandle, I, True, mii))
        or (mii.fType and mft_Separator <> 0)
        or (mii.fState and (mfs_Disabled + mfs_Grayed) <> 0)
        then Continue;
        S:= StrPas(Z);
      end
      else
        if (not (M.Visible and M.Enabled))
        or ((M is TMenuItem2000)
        and (TMenuItem2000(M).Hidden)
        and (not (fsShowHidden in State)))
        then Continue
        else S:= M.Caption;
      if IsAccelEx(Msg.CharCode, S, UseFirstLetter) then begin
        SelectedIndex:= I;
        Exclude(State, fsSelectedChanged);
        if ((M <> nil) and (M.Enabled))
        or ((M = nil) and (mii.fState and (mfs_Grayed + mfs_Disabled) = 0))
        then MouseUp(mbLeft, [], 0, 0)
        else MessageBeep(0);
        Msg.Result:= 1;
        Exit;
      end;
    end { for  };
  until UseFirstLetter { repeat };
  MessageBeep(0);
end;
procedure TPopupMenu2000Form.wmKeyDown(var Msg: TWMKeyDown);
  // keyboard events
var
  M: TMsg;
  Shift: TShiftState;
begin
  // handle focus item
  if (FocusItem <> nil)
  and (fsDisabled in State)
  and (FocusItem is TMenuItem2000)
  then begin
    // get shift state
    Shift:= [];
    if GetKeyState(vk_Shift) < 0    then Include(Shift, ssShift);
    if GetKeyState(vk_Control) < 0  then Include(Shift, ssCtrl);
    if Msg.KeyData and AltMask <> 0 then Include(Shift, ssAlt);
    // handle char
    case Msg.CharCode of
      vk_Escape, vk_Return:
        begin
          TMenuItem2000(FocusItem).AsEdit.CancelEdit(Msg.CharCode = vk_Return);
          Exclude(State, fsDisabled);
          FocusItem:= nil;
          Paint;
          Msg.Result:= 1;
        end;
      else
        // send char
        TMenuItem2000(FocusItem).ControlOptions.KeyDown(Msg.CharCode, Shift);
    end;
    // set result
    if Msg.CharCode = 0 then Msg.Result:= 1;
  end
  // other menu item
  else
  case Msg.CharCode of
    // click item
    vk_Return:
      begin
        MouseUp(mbLeft, [], 0, 0);
        Msg.Result:= 1;
      end;
    vk_Up:
      begin
        SelectedIndex:= SelectedIndex -1;
        Timer.Enabled:= False;
        Msg.Result:= 1;
      end;
    vk_Tab:
      begin
        if GetKeyState(vk_Shift) < 0
        then SelectedIndex:= SelectedIndex -1
        else SelectedIndex:= SelectedIndex +1;
        Timer.Enabled:= False;
        Msg.Result:= 1;
      end;
      
    vk_Down:
      begin
        if GetKeyState(vk_Control) < 0 then begin
          ASTimer.Enabled:= False;
          Include(State, fsShowHidden);
          SilentHide;
          Animate;
        end
        else begin
          SelectedIndex:= SelectedIndex +1;
          Timer.Enabled:= False;
        end;
        Msg.Result:= 1;
      end;
    vk_Left:
      if ParentMenuForm <> nil then begin;
        if not (fsAnimated in State)
        then SilentHide;
        Release;
        Msg.Result:= 1;
      end;
    vk_Right:
      if (GetCurMenuItem(False) <> nil)
      and (CurMenuItem.Enabled)
      and HasSubmenu(CurMenuItem)
      then begin
        PopupSubMenuForm(True);
        Msg.Result:= 1;
      end;
    vk_Escape:
      begin
        if not (fsAnimated in State)
        then SilentHide;
        if (ParentMenuForm <> nil)
        then begin
          Exclude(ParentMenuForm.State, fsDisabled);
          Release;
        end
        else KillActivePopupMenu2000(False, False);
        Msg.Result:= 1;
      end;
    vk_F1:
      if (Application.HelpFile <> '')
      and (GetCurMenuItem(False) <> nil)
      and (CurMenuItem.HelpContext <> 0)
      then begin
        KillActivePopupMenu2000(True, False);
        if (PopupMenu <> nil)
        and (PopupMenu.Owner is TForm)
        and (biHelp in TForm(PopupMenu.Owner).BorderIcons)
        then Application.HelpCommand(HELP_CONTEXTPOPUP, CurMenuItem.HelpContext)
        else Application.HelpCommand(HELP_CONTEXT, CurMenuItem.HelpContext);
        // We have to remove the next message that is in the queue.
        PeekMessage(M, 0, 0, 0, pm_Remove);
        Msg.Result:= 1;
      end;
    else
      if (Msg.CharCode <> vk_Shift) and (Msg.CharCode <> vk_Control)
      then begin
        SearchForOpenedMenuShortcut(Msg);
        Msg.Result:= 1;
      end;
  end;
  // hide tooltip
  if (ToolTipWindow <> nil)
  then ToolTipWindow.Deactivate;
end;
procedure TPopupMenu2000Form.wmChar(var Msg: TWMChar);
var
  C: Char;
begin
  // handle focus item
  if (FocusItem <> nil)
  and (fsDisabled in State)
  then begin
    // send char
    C:= Char(Msg.CharCode);
    if (FocusItem is TMenuItem2000)
    then TMenuItem2000(FocusItem).ControlOptions.KeyPress(C);
    // set result
    if C = #0 then Msg.Result:= 1;
  end;
end;
procedure TPopupMenu2000Form.wmSysKeyDown(var Msg: TWMKeyDown);
begin
  // hide active menu
  if (Msg.CharCode = vk_Menu) or (Msg.CharCode = vk_F10) then begin
    KillActivePopupMenu2000(True, False);
    if Assigned(ActiveMenuBar)
    then ActiveMenuBar.SetDisableAltKeyUp(True);
    FullShowCaret;
    Msg.Result:= 1;
    Exit;
  end;
  // handle as menu key
  wmKeyDown(Msg);
end;
// thanks for this routine to Stewart Creswell
procedure TPopupMenu2000Form.SetZOrder(TopMost : Boolean);
const
  NormalWindowPos: array[Boolean] of HWND = (HWND_BOTTOM, HWND_TOP);
  TopWindowPos: array[Boolean] of HWND = (HWND_NOTOPMOST, HWND_TOPMOST);
begin
  if Parent <> nil
  then
    inherited
  else
    if Handle <> 0 then
      if FormStyle = fsStayOnTop
      then SetWindowPos(Handle, TopWindowPos[TopMost], 0, 0, 0, 0, FormFlags)
      else SetWindowPos(Handle, NormalWindowPos[TopMost], 0, 0, 0, 0, FormFlags);
end;
procedure TPopupMenu2000Form.PopupMenu2000FormTimer(Sender: TObject);
var
  fw: HWND;
  C: TComponent;
begin
  if fsDisabled in State then Exit;
  Timer.Enabled:= False;
  if fsSelectedChanged in State then begin
    Exclude(State, fsSelectedChanged);
    GetCurMenuItem(False);
    // this is because DrawDisabled = True when selecton is moved by kbd
    // and = False when is moved by the mouse :)
    if not (fsDrawDisabled in State)
    then CheckShowHint(CurMenuItem, True, Self);
    // if submenu is not actual
    if (SubMenuForm = nil)
    or ((CurMenuItem <> SubMenuForm.MenuItems)
    and ((not (CurMenuItem is TMenuItem2000))
     or (TMenuItem2000(CurMenuItem).AttachMenu = nil)
     or (TMenuItem2000(CurMenuItem).AttachMenu.Items <> SubMenuForm.MenuItems)))
    then PopupSubMenuForm(False);
  end;
  // close menus when owner *and* menu windows (and ActiveMdiChild) is not active
  fw:= GetForegroundWindow;
  C:= FindControl(fw);
  if not ((fw = 0)
  or (C is Forms.TForm)
  or (fw = Application.Handle))
  then begin
    FullShowCaret;
    KillActivePopupMenu2000(True, False);
    Exit;
  end;
  if not (fsKillAnimate in State) then
    Timer.Enabled:= True;
end;
procedure TPopupMenu2000Form.TimerShow(Sender: TObject);
begin
  ASTimer.Enabled:= False;
  // check is mouse cursor still over the hidden arrow
  if SelectedIndex = itHiddenArrow then begin
    Include(State, fsShowHidden);
    Animate;
  end;
end;
procedure TPopupMenu2000Form.DestroySubMenuForm;
begin
  if Assigned(SubMenuForm) then begin
    SubMenuForm.SilentHide;
    SubMenuForm.Release;
    SubMenuForm:= nil;
  end;
end;
procedure TPopupMenu2000Form.CreateSubMenuForm(Menu: TPopupMenu; Handle: HMenu; Items: TMenuItem);
begin
  if (Menu is TCustomPopupMenu2000)
  or (Menu = nil)
  then
  try
    SubMenuForm:= TPopupMenu2000Form.Create(Owner);
    SubMenuForm.Font.Assign(Font);
    SubMenuForm.ParentMenuForm:= Self;
    SubMenuForm.MenuHandle:=     Handle;
    SubMenuForm.MenuItems:=      Items;
    SubMenuForm.ParentMenuIndex:=SelectedIndex;
    SubMenuForm.Animation:=      Animation;
    SubMenuForm.CloseAnimation:= CloseAnimation;
    if Menu = nil
    then SubMenuForm.PopupMenu:= PopupMenu
    else SubMenuForm.PopupMenu:= TCustomPopupMenu2000(Menu);
  except
    SubMenuForm:= nil
  end;
end;
procedure TPopupMenu2000Form.PopupSubMenuForm(SelectFirst: Boolean);
var
  X: Integer;
  hSubMenu: HMenu;
  Item: TMenuItem;
  Popup: TPopupMenu;
begin
  hSubMenu:= 0;
  Popup:= nil;
  // first try - use GetCurMenuItem
  Item:= GetCurMenuItem(False);
  // check if sub menu already open
  if ((SubMenuForm <> nil)
  and ((SubMenuForm.MenuItems = Item)
  or ((Item is TMenuItem2000)
    and (TMenuItem2000(Item).AttachMenu <> nil)
    and (SubMenuForm.MenuItems = TMenuItem2000(Item).AttachMenu.Items))))
  or (fsKillAnimate in State)
  then Exit;
  DestroySubmenuForm;
  // exit on disabled items
  if (Item <> nil) and (not Item.Enabled)
  then Exit;
  if Item <> nil then begin
    if (Item is TMenuItem2000)
    and (TMenuItem2000(Item).AttachMenu <> nil)
    then begin
      Popup:= TMenuItem2000(Item).AttachMenu;
      Popup.PopupComponent:= CurMenuItem;
      if Popup.Items.Count = 0
      then TCustomPopupMenu2000(Popup).InitItems(True);
      Item:= Popup.Items;
    end;
    // if disabled or empty or no menu attached then exit
    if (not Item.Enabled)
    or (Item.Count = 0)
    then Exit;
    hSubMenu:= Item.Handle;
  end
  // second try - use GetMenuItemInfo()
  else
  if FSelectedIndex >= 0 then begin
    mii.fMask:= miim_State + miim_SubMenu;
    GetMenuItemInfo(MenuHandle, FSelectedIndex, True, mii);
    hSubMenu:= mii.hSubMenu;
    // if disabled then exit
    if mii.fState and (mfs_Disabled + mfs_Grayed) <> 0 then Exit;
  end;
  
  // no submenu
  if (hSubMenu = 0) then Exit;
  // on click event
  if (Item <> nil)
  and Assigned(Item.OnClick)
  then Item.OnClick(CurMenuItem);
  // init popup menu
  if (Popup <> nil) then begin
    Popup.PopupComponent:= CurMenuItem;
    // on popup event
    if Assigned(Popup.OnPopup)
    then Popup.OnPopup(CurMenuItem);
  end;
  CreateSubMenuForm(Popup, hSubMenu, Item);
  // set alignment
  if Options.Alignment <> taRightToLeft
  then X:= Width -5
  else X:= 5;
  // set first selected
  if SelectFirst then SubMenuForm.FSelectedIndex:= 0;
  // convert point
  with ClientToScreen(Point(X, GetItemRect(FSelectedIndex).Top -5)) do
    SubMenuForm.SetBounds(X, Y, 0, 0);
{$IFDEF Delphi4OrHigher}
  SubMenuForm.DefaultMonitor:= dmActiveForm;
{$ENDIF}
  SubMenuForm.Animate;
end;
procedure TPopupMenu2000Form.BringMenuToFront;
var
  F: TPopupMenu2000Form;
begin
  if (fsKillAnimate in State) then Exit;
  // process all submenus
  F:= Self;
  while Assigned(F) do begin
    SetWindowPos(F.Handle, hwnd_TopMost, F.Left, F.Top, F.Width, F.Height, FormFlags);
    F:= F.SubMenuForm;
  end;
end;
function TPopupMenu2000Form.GetCurMenuItem(RaiseException: Boolean): Menus.TMenuItem;
begin
  Result:= GetMenuItemIndex(SelectedIndex, RaiseException);
end;
function TPopupMenu2000Form.GetMenuItemIndex(Index: Integer; RaiseException: Boolean): TMenuItem;
var
  I, C: Integer;
  M: TMenuItem;
begin
  Result:= nil;
  CurMenuItem:= nil;
  if (MenuItems = nil)
  or (Index >= MenuItems.Count)
  then Exit;
  CurHiddenCount:= 0;
  C:= -1;
  for I:= 0 to MenuItems.Count -1 do begin
    M:= MenuItems[I];
    // menu item is not visible
    if not M.Visible
    then Continue;
    // menu item is hidden
    if  (not (fsShowHidden in State))
    and (M is TMenuItem2000)
    and (TMenuItem2000(M).Hidden)
    then begin
      Inc(CurHiddenCount);
      Continue;
    end;
   // else
    Inc(C);
    if C = Index then begin
      CurMenuItem:= MenuItems[I];
      Result:= CurMenuItem;
      Exit;
    end;
  end;
  if RaiseException then
    raise Exception.Create('Menu item not found.');
end;
{ Main Routines }
function TPopupMenu2000Form.Animate: Boolean;
var
  CurAnim: T_AM2000_Animation;
  abd: TAppBarData;
  SR: TRect; // original screen rect
  X: Integer;
  DDC: HDC;
begin
  Perform(wm_InitState, 0, 0);
  DX:= 1;
  DY:= 1;
  Result:= True;
  CurHiddenCount:= 0;
  FocusItem:= nil;
  Include(State, fsAnimated);
  Exclude(State, fsKillAnimate);
  // calculate real coords of Windows Desktop without TaskBar
  abd.cbSize:= sizeOf(abd);
  abd.hWnd:= Handle;
  SHAppBarMessage(abm_GetTaskBarPos, abd);
  SubtractRect(SR, Rect(0, 0, Screen.Width, Screen.Height), abd.rc);
  // calculate normal height and width.
  // mx and mx -- width and height of the full opened window
  RebuildBounds;
  MX:= GetRealWidth;
  MY:= GetRealHeight;
  Buffer.Width:= MX;
  Buffer.Height:= MY;
  Buffer.FreeImage;
  // code to arrange menu form
  BL:= 0;
  if Options.Alignment <> taRightToLeft then begin
    Exclude(State, fsFromRightToLeft);
    if (Left + MX) > SR.Right
    then
      if Assigned(ParentMenuForm)
      then begin
        if Animation = anVSlide
        then Left:= ParentMenuForm.Left - MX +6
        else Left:= ParentMenuForm.Left +6;
        Include(State, fsFromRightToLeft);
      end
      else Left:= SR.Right - MX;
    if Left <= 0 then Left:= 1;
  end
  else begin
    Include(State, fsFromRightToLeft);
    if Left > SR.Right then Left:= SR.Right;
  end;
  if (((Top + MY) < SR.Bottom) or (Top < MY)
  or (Animation = anHSlide))
  then Exclude(State, fsFromBottomToTop)
  else Include(State, fsFromBottomToTop);
  if (fsFromBottomToTop in State)
  then begin
    // menu shouldn't hide a menu button
    if (PopupMenu.PopupComponent is TCustomMenuBar2000)
    then
    with TCustomMenuBar2000(PopupMenu.PopupComponent) do
        if mbType = mbVertical then
             Self.Top:= SR.Bottom
        else Self.Top:= Self.Top - (aiRect.Bottom - aiRect.Top +2);
  end
  else
    if Top + MY > SR.Bottom
    then Top:= SR.Bottom - MY;
  if Top <= 0 then Top:= 1;
  if Options.Alignment <> taRightToLeft
  then NewLeft:= Left
  else NewLeft:= Left - MX;
  NewTop:= Top;
  NewWidth:= MX;
  NewHeight:= MY;
  // code for calculation animation steps
  CurAnim:= Animation;
  if CurAnim = anRandom then begin
    if Random(2) = 0 then CurAnim:= anHSlide
                     else CurAnim:= anVSlide;
  end;
  if CurAnim = anSmart then begin
    Animation:= anHSlide;
    CurAnim:= anVSlide;
  end;
  if CurAnim = anPopup then begin
    Animation:= anHSlide;
    CurAnim:= anUnfold;
  end;
  if CurAnim in [anHSlide, anUnfold] then DX:= MX div nSteps;
  if DX < 3 then DX:= 3;
  if CurAnim in [anVSlide, anUnfold] then DY:= MY div (2 * nSteps);
  if DY < 3 then DY:= 3;
  if DX < DY then DX:= DY;
  if CurAnim in [anVSlide, anUnfold] then begin
    NewHeight:= MY div 3 - DY;
    if (fsFromBottomToTop in State)
    then Top:= Top - NewHeight;
  end;
  if CurAnim in [anHSlide, anUnfold] then NewWidth:=  0;
  // check if mouse already moved
  ProcessMouseMoveMessages;
  if (fsKillAnimate in State) then begin
    Exclude(State, fsAnimated);
    Result:= False;
    Exit;
  end;
  // start
  Include(State, fsPaintMenu);
  Paint;
  // init fade in animation
  if CurAnim = anFadeIn then begin
    BitsSize:= (MX +1) * MY * SizeOf(TRgbTriple);
    // nado
    if bits1 <> nil then Freemem(bits1);
    GetMem(bits1, BitsSize);
    bi.bmiHeader.biSize:= SizeOf(bi.bmiHeader);
    bi.bmiHeader.biWidth:= MX;
    bi.bmiHeader.biHeight:= MY;
    bi.bmiHeader.biPlanes:= 1;
    bi.bmiHeader.biBitCount:= 24;
    bi.bmiHeader.biCompression:= bi_RGB;
    bi.bmiHeader.biSizeImage:= 0;
    GetDIBits(Buffer.Canvas.Handle, Buffer.Handle, 0, MY, bits1, bi, Dib_Rgb_Colors);
    // DDC
    DDC:= CreateDC('DISPLAY', nil, nil, nil);
    // est
    BitBlt(Buffer.Canvas.Handle, 0, 0, MX, MY, DDC, Left, Top, SrcCopy);
    DeleteDC(DDC);
    if bits0 <> nil then Freemem(bits0);
    GetMem(bits0, BitsSize);
    GetDIBits(Buffer.Canvas.Handle, Buffer.Handle, 0, MY, bits0, bi, Dib_Rgb_Colors);
    // temp
    if bits <> nil then Freemem(bits);
    GetMem(bits, BitsSize);
    // iterate
    if dbits <> nil then Freemem(dbits);
    GetMem(dbits, BitsSize);
    for X:= 0 to BitsSize -1 do
      dbits^[X]:= Integer((Integer(bits1^[X]) - Integer(bits0^[X]))) div (3*nSteps);
    CurStep:= 1;
    SetBounds(NewLeft, NewTop, NewWidth, NewHeight);
    Perform(wm_SetRedraw, 0, 0);
    if Owner is TForm
    then TForm(Owner).Perform(wm_SetRedraw, 0, 0);
    SilentShow;
    BitBlt(Canvas.Handle, 0, 0, Buffer.Width, Buffer.Height, Buffer.Canvas.Handle, 0, 0, Canvas.CopyMode);
    Perform(wm_SetRedraw, 1, 0);
    if Owner is TForm
    then TForm(Owner).Perform(wm_SetRedraw, 1, 0);
    ProcessPaintMessages;
  end;
  if CurAnim <> anFadeIn then SilentShow;
  sndPlaySound(PChar(MenuPopupSound), snd_Async + snd_NoDefault + snd_NoStop);
  SendMessage(Handle, wm_ShowAnimated, GetCurrentTime, nTimeout);
end;
procedure TPopupMenu2000Form.wmKillAnimation(var Msg: TMessage);
  // cancels active animation
begin
  if fsBecomingDraggable in State then Exit;
  Include(State, fsKillAnimate);
  Exclude(State, fsAnimated);
  // process submenu
  if Assigned(SubMenuForm)
  then SubMenuForm.Perform(wm_KillAnimation, 0, 0);
end;
procedure TPopupMenu2000Form.wmShowAnimated(var Msg: TMessage);
var
  CT, X: Integer;
begin
  if (fsKillAnimate in State) then Exit;
  // delay
  CT:= Msg.LParam - (GetCurrentTime - Msg.WParam);
  if (CT > 0) and (CT < 1000) then Sleep(CT);
  Msg.LParam:= 0;
  if Animation = anFadeIn then begin
    if CurStep <= 3*nSteps then begin
      TimeStart:= GetCurrentTime;
      for X:= 0 to BitsSize -1 do
        bits^[X]:= bits0^[X] + dbits^[X] * CurStep;
      SetDIBits(Buffer.Canvas.Handle, Buffer.Handle, 0, MY, bits, bi, Dib_Rgb_Colors);
      BitBlt(Canvas.Handle, 0, 0, Buffer.Width, Buffer.Height, Buffer.Canvas.Handle, 0, 0, Canvas.CopyMode);
      ProcessMouseMoveMessages;
//      ProcessPaintMessages;
      Inc(CurStep);
      CT:= GetCurrentTime;
      PostMessage(Handle, wm_ShowAnimated, CT, nTimeout - (CT - TimeStart));
      Exit;
    end;
    Include(State, fsPaintMenu);
    
  end
  else begin
    // Animation!
    while (NewWidth < MX) or (NewHeight < MY) do begin
      // calculate the time wasted on drawing
      TimeStart:= GetCurrentTime;
      if NewWidth < MX then
        if (NewWidth + DX) >= MX then Break
        else begin
          NewWidth:= NewWidth + DX;
          if fsFromRightToLeft in State
          then NewLeft:= Left - DX;
        end;
      if NewHeight < MY then
        if (NewHeight + DY) >= MY then Break
        else begin
          NewHeight:= NewHeight + DY;
          if fsFromBottomToTop in State
          then NewTop:= Top - DY;
        end;
      SetBounds(NewLeft, NewTop, NewWidth, NewHeight);
      Paint;
      ProcessMouseMoveMessages;
      ProcessPaintMessages;
      // it's necessary in case of menu already opened by another thread
      NewWidth:= Width;
      NewHeight:= Height;
      // adjust delay
      CT:= GetCurrentTime;
      PostMessage(Handle, wm_ShowAnimated, CT, nTimeout - (CT - TimeStart));
      Exit;
    end;
    // final setting bounds
    if fsFromBottomToTop in State then NewTop:= Top - (MY - Height) +1;
    if fsFromRightToLeft in State then NewLeft:= Left - (MX - Width);
  end;
  // finish
  SetBounds(NewLeft, NewTop, MX, MY);
  Paint;
  // finalization
  Exclude(State, fsAnimated);
  Exclude(State, fsKillAnimate);
  Timer.Enabled:= Assigned(PopupMenu);
end;
procedure TPopupMenu2000Form.SilentShow;
begin
  // special check for tray-icon menu
  FullHideCaret;
  RebuildToolTipWindow(False);
  Exclude(State, fsDisabled);
  ShowWindow(Handle, sw_ShowNA);
  if Assigned(Application.MainForm)
  and not Application.MainForm.Visible
  then SetForegroundWindow(Handle);
  SetWindowPos(Handle, hwnd_TopMost, Left, Top, Width, Height, FormFlags);
end;
procedure TPopupMenu2000Form.SilentHide;
  // hides the current window
begin
  Timer.Enabled:= False;
  if Assigned(SubMenuForm) then begin
    SubMenuForm.SilentHide;
    SubMenuForm.Release;
    SubMenuForm:= nil;
  end;
  if fsBecomingDraggable in State then begin
    Timer.Enabled:= True;
    Exit;
  end;
  ShowWindow(Handle, sw_Hide);
  SetBounds(Left, Top, 0, 0);
  FSelectedIndex:= itNothing;
  ProcessPaintMessages;
  // remove arrays
  if dbits <> nil then FreeMem(dbits); dbits:= nil;
  if bits <> nil then FreeMem(bits);  bits:= nil;
  if bits0 <> nil then FreeMem(bits0);  bits0:= nil;
  if bits1 <> nil then FreeMem(bits1); bits1:= nil;
end;
procedure TPopupMenu2000Form.AnimatedHide;
  // hides the current window
var
  I, X: Integer;
begin
  Timer.Enabled:= False;
  if Owner is TForm
  then TForm(Owner).Perform(wm_SetRedraw, 0, 0);
  if (SelectedIndex >= 0)
  and (SelectedIndex < ItemRects.Count)
  then begin
    // nado
    SetDIBits(Buffer.Canvas.Handle, Buffer.Handle, 0, MY, bits0, bi, Dib_Rgb_Colors);
    // est
    Paint;
    GetDIBits(Buffer.Canvas.Handle, Buffer.Handle, 0, MY, bits1, bi, Dib_Rgb_Colors);
    Move(bits1^, bits^, BitsSize);
    // temp
    for X:= 0 to BitsSize -1 do
      dbits^[X]:= Integer(Integer(bits1^[X]) - Integer(bits0^[X])) div (2*nSteps);
    // animation
    for I:= 2*nSteps -1 downto 0 do begin
      for X:= 0 to BitsSize -1 do
        if dbits^[X] <> 0
        then bits^[X]:= bits0^[X] + dbits^[X] * I;
      SetDIBits(Buffer.Canvas.Handle, Buffer.Handle, 0, MY, bits, bi, Dib_Rgb_Colors);
      BitBlt(Canvas.Handle, 0, 0, Buffer.Width, Buffer.Height, Buffer.Canvas.Handle, 0, 0, Canvas.CopyMode);
      Sleep(nTimeout);
    end;
  end;
  SilentHide;
  if Owner is TForm
  then TForm(Owner).Perform(wm_SetRedraw, 1, 0);
  
end;
procedure TPopupMenu2000Form.Repaint;
begin
  Include(State, fsPaintMenu);
  Paint;
end;
procedure TPopupMenu2000Form.WMKillTimer(var Msg: TMessage);
begin
  Timer.Enabled:= False;
  // process submenu
  if (SubMenuForm <> nil)
  then SubMenuForm.Perform(wm_KillTimer, 0, 0);
end;
procedure TPopupMenu2000Form.wmHideSilent(var Msg: TMessage);
begin
  if (Msg.LParam <> 0)
  and (Animation = anFadeIn)
  and (SubMenuForm = nil)
  then
    AnimatedHide
  else begin
    // process submenu first
    if (SubMenuForm <> nil)
    then SubMenuForm.Perform(wm_HideSilent, 0, Msg.LParam);
    SilentHide;
  end;
end;
{ Get Routines }
function TPopupMenu2000Form.GetMenuItemHeight(const M: TMenuItem): Integer;
var
  Lines: Integer;
begin
  Result:= 0;
  if M = nil then Exit;
  if M.Caption = '-'
  then
    Result:= Options.SeparatorHeight
  else begin
    Lines:= GetNumLines(M.Caption);
    Inc(Result, ItemHeight * Lines);
    if (M is TMenuItem2000)
    then
      with TMenuItem2000(M) do
        if (Control <> ctlNone)
        then
          Result:= TMenuItem2000(M).GetHeight(ItemHeight)
        else
          if Hidden
          and not (fsHiddenAsRegular in State)
          then Inc(Result, 2);
  end;
end;
function TPopupMenu2000Form.GetMenuItemHeightIndex(Index: Integer): Integer;
begin
  with GetItemRect(Index) do Result:= Bottom - Top;
end;
procedure TPopupMenu2000Form.Paint;
var
  X, Y, I, Temp, CopyMode: Integer;
  R: TRect;
  OldPalette, op1: HPalette;
  M, M1, M0, M2: TMenuItem;
  P: TPoint;
  Y1, C1, C2, R1, G1, B1, I1, I2: Integer;
  DR, DG, DB, DH, F1, F2: Real;
begin
  if (fsAnimated in State)
  and (Animation = anFadeIn)
  and (not (fsPaintMenu in State))
  then Exit;
  // init DrawRect record
  DrawRect.State:= [];
  DrawRect.Canvas:= Buffer.Canvas;
  DrawRect.Handle:= MenuHandle;
  DrawRect.Options:= Options;
  DrawRect.MouseState:= MouseState;
  DrawRect.FullRepaint:= fsPaintMenu in State;
  if (PopupMenu <> nil)
  then DrawRect.Images:= TImageList(TCustomPopupMenu2000(PopupMenu).Images);
  // calculate bounds
  if (BorderStyle <> bsNone)
  then begin
    DrawRect.mir.Border:= 0;
    DrawRect.mir.LineRight:= ClientWidth;
  end
  else begin
    if (fsCtl3D in State)
    then DrawRect.mir.Border:= Options.Margins.Border +2
    else DrawRect.mir.Border:= Options.Margins.Border;
    DrawRect.mir.LineRight:= Buffer.Width - DrawRect.mir.Border;
  end;
  Y:= Options.Margins.Top + DrawRect.mir.Border;
  DrawRect.mir.LineLeft:= DrawRect.mir.Border;
  if (Options.Draggable)
  and (BorderStyle = bsNone)
  then Inc(Y, 10);
  DrawRect.mir.ItemWidth:= ItemWidth;
  DrawRect.mir.ShortcutWidth:= ShortcutWidth;
  if Options.Title.Visible then
    case Options.Title.Align of
      atLeft:  Inc(DrawRect.mir.LineLeft, Options.Title.Width);
      atRight: Dec(DrawRect.mir.LineRight,  Options.Title.Width);
    end;
  if Options.Alignment <> taRightToLeft
  then begin
    DrawRect.mir.ItemLeft:= DrawRect.mir.LineLeft + Options.Margins.Left;
    DrawRect.mir.ShortcutLeft:= DrawRect.mir.LineRight - Options.Margins.Right - DrawRect.mir.ShortcutWidth;
    DrawRect.mir.BitmapLeft:= DrawRect.mir.LineLeft;
    DrawRect.mir.TriangleWidth:= Options.Margins.Right -4;
    DrawRect.mir.TriangleLeft:= DrawRect.mir.LineRight - DrawRect.mir.TriangleWidth -2;
  end
  else begin
    DrawRect.mir.ShortcutLeft:= DrawRect.mir.LineLeft + Options.Margins.Left;
    DrawRect.mir.ItemLeft:= DrawRect.mir.LineRight - Options.Margins.Right - DrawRect.mir.itemWidth;
    DrawRect.mir.BitmapLeft:= DrawRect.mir.LineRight - Options.ItemHeight -1;
    DrawRect.mir.TriangleWidth:= Options.Margins.Left -4;
    DrawRect.mir.TriangleLeft:= DrawRect.mir.Border;
  end;
  if Options.Alignment <> taRightToLeft
  then DrawRect.mir.BitmapWidth:= DrawRect.mir.LineLeft + Options.Margins.Left - DrawRect.mir.BitmapLeft -3
  else DrawRect.mir.BitmapWidth:= DrawRect.mir.LineRight - DrawRect.mir.BitmapLeft -2;
  // select background's palette (if any)
  OldPalette:= 0;
  if (not Options.Background.Empty) then begin
    if (Options.Background.Palette <> 0) then begin
      OldPalette:= SelectPalette(Buffer.Canvas.Handle, Options.Background.Palette, True);
      RealizePalette(Buffer.Canvas.Handle);
    end;
    Include(DrawRect.State, isGraphBack);
    // fit background to menu
    if fsPaintMenu in State then begin
      op1:= 0;
      Back.Width:= Buffer.Width;
      Back.Height:= Buffer.Height;
      Back.FreeImage;
      with Back.Canvas do begin
        Brush.Style:= bsSolid;
        Brush.Color:= Options.Colors.Menu;
        FillRect(ClipRect);
      end;
      if Options.Background.Palette <> 0 then begin
        op1:= SelectPalette(Back.Canvas.Handle, Options.Background.Palette, True);
        RealizePalette(Back.Canvas.Handle);
      end;
      case Options.BackgroundDisplay of
        bdDefault, bdExpand:
          BitBlt(Back.Canvas.Handle, 0, 0, Back.Width, Back.Height,
            Options.Background.Canvas.Handle, 0, 0, SrcCopy);
        bdCenter:
          with DrawRect.mir do begin
            R.Left:= LineLeft;
            R.Right:= R.Left + Options.Background.Width;
            R.Top:= Border;
            R.Bottom:= R.Top + Options.Background.Height;
            OffsetRect(R, ((LineRight - LineLeft) - Options.Background.Width) div 2 - Border,
              (Buffer.Height - Options.Background.Height) div 2 - Border);
            BitBlt(Back.Canvas.Handle, R.Left, R.Top, R.Right - R.Left, R.Bottom - R.Top,
              Options.Background.Canvas.Handle, 0, 0, SrcCopy);
          end;
        bdTile:
          with Back.Canvas do begin
            Brush.Bitmap:= Options.Background;
            FillRect(ClipRect);
          end;
        bdStretch:
          with DrawRect.mir, Options.Background do
            StretchBlt(Back.Canvas.Handle, 0, 0, LineRight, Buffer.Height,
              Canvas.Handle, 0, 0, Width, Height, SrcCopy);
      end;
      if op1 <> 0
      then SelectPalette(Back.Canvas.Handle, op1, True);
    end;
  end;
  // mouse position
  GetCursorPos(DrawRect.MousePos);
  DrawRect.MousePos:= ScreenToClient(DrawRect.MousePos);
  // paint CanTearOff plane
  if (Options.Draggable)
  and ((fsPaintMenu in State)
    or ((fsSelectedChanged in State) and ((SelectedIndex = itDragPane)
      or (LastSelectedIndex = itDragPane))))
  and (BorderStyle = bsNone)
  then
    with Buffer, Canvas do begin
      Brush.Style:= bsSolid;
      if SelectedIndex = itDragPane
      then begin C1:= ColorToRGB(clActiveCaption); C2:= ColorToRGB(clGradientActiveCaption); end
      else begin C1:= ColorToRGB(clInactiveCaption); C2:= ColorToRGB(clGradientInactiveCaption); end;
      // gradient!
      DH:= (DrawRect.mir.LineRight - DrawRect.mir.LineLeft)/256;
      R1:= GetRValue(C1);
      G1:= GetGValue(C1);
      B1:= GetBValue(C1);
      DR:= (GetRValue(C2) - R1 +1)/256;
      DG:= (GetGValue(C2) - G1 +1)/256;
      DB:= (GetBValue(C2) - B1 +1)/256;
      for Y1:= 0 to 255 do begin
        Brush.Color:= Rgb(R1 + Round(DR*Y1), G1 + Round(DG*Y1), B1 + Round(DB*Y1));
        F1:= Y1*DH;
        F2:= (Y1 +1)*DH;
        I1:= Round(F1);
        I2:= Round(F2);
        FillRect(Rect(DrawRect.mir.LineLeft + I1, DrawRect.mir.Border, DrawRect.mir.LineLeft + I2, DrawRect.mir.Border +7));
      end;
      // bottom line
      Brush.Color:= Options.Colors.Menu;
      FillRect(Rect(DrawRect.mir.LineLeft, DrawRect.mir.Border +7, DrawRect.mir.LineRight, DrawRect.mir.Border +10));
    end;
  M:= nil;
  M1:= GetMenuItemIndex(0, False);
  // repeat for each menu item
  for I:= 0 to ItemRects.Count -1 do begin
    M0:= M;
    M:= M1;
    M1:= GetMenuItemIndex(I +1, False);
    Temp:= GetMenuItemHeightIndex(I);
    DrawRect.mir.Top:= Y;
    DrawRect.mir.Height:= Temp;
    // init state
    SetState(DrawRect.State, isSelected, SelectedIndex = I);
    Exclude(DrawRect.State, isNoLeftSunken);
    Exclude(DrawRect.State, isNoRightSunken);
    if fsShowHidden in State then begin
      if not (fsHiddenAsRegular in State) then begin
        SetState(DrawRect.State, isHidden, (M is TMenuItem2000) and (TMenuItem2000(M).Hidden));
        SetState(DrawRect.State, isHiddenPrev, ((M0 is TMenuItem2000) and (TMenuItem2000(M0).Hidden))
          or ((M0 = nil) and (isHidden in DrawRect.State)));
        SetState(DrawRect.State, isHiddenSucc, ((M1 is TMenuItem2000) and (TMenuItem2000(M1).Hidden))
          or ((M1 = nil) and (isHidden in DrawRect.State)));
        if (isHidden in DrawRect.State) then begin
          // hide next separator
          if (not (isHiddenSucc in DrawRect.State))
          and (M1 <> nil)
          and (M1.Caption = '-') then begin
            M2:= GetMenuItemIndex(I +2, False);
            if (M2 is TMenuItem2000)
            and (TMenuItem2000(M2).Hidden)
            then SetState(DrawRect.State, isHiddenSucc, True);
          end;
          // hide prev separator
          if (not (isHiddenPrev in DrawRect.State))
          and (M0 <> nil)
          and (M0.Caption = '-') then begin
            M2:= GetMenuItemIndex(I -2, False);
            if (M2 is TMenuItem2000)
            and (TMenuItem2000(M2).Hidden)
            then SetState(DrawRect.State, isHiddenPrev, True);
          end;
          if Options.Title.Visible then begin
            SetState(DrawRect.State, isNoLeftSunken, Options.Title.Align = atLeft);
            SetState(DrawRect.State, isNoRightSunken, Options.Title.Align = atRight);
          end;
        end;
      end;
    end
    // ignore separator in Window menu
    else
      if (CurHiddenCount > 0)
      and (CurHiddenCount = MenuItems.Count)
      then Inc(CurHiddenCount);
    // handle focus item
    SetState(DrawRect.State, isActivated, (msLeftButton in MouseState) or ((FocusItem = M)
      and (fsDisabled in State)));
    DrawRect.Item:= M;
    DrawRect.Index:= I;
    // is menu item should be drawn?
    if (fsPaintMenu in State)
    or (((I = SelectedIndex) or (I = LastSelectedIndex))) then begin
      // draw background
      if not Back.Empty
      then begin
        if I = SelectedIndex
        then CopyMode:= NotSrcCopy
        else CopyMode:= Buffer.Canvas.CopyMode;
        with DrawRect.mir.LineRect do
          BitBlt(Buffer.Canvas.Handle, Left, Top, Right - Left, Bottom - Top,
            Back.Canvas.Handle, 0, Y, SrcCopy);
      end;
      // draw menu item
      // win32 menu item
      if M = nil
      then begin
        Inc(DrawRect.Index, CurHiddenCount);
        DrawMenuItemWin32(@DrawRect);
      end
      else
      // control
      if (M is TMenuItem2000) and (TMenuItem2000(M).Control <> ctlNone)
      then
        TMenuItem2000(M).ControlOptions.Draw(@DrawRect)
      else
      // ordinary menu item
        DrawMenuItem(@DrawRect);
    end;
    // increment Y
    Inc(Y, Temp);
    // fill interitem space
    if (fsPaintMenu in State)
    and (Options.Margins.Space > 0)
    and (I < ItemRects.Count -1)
    then
      if not Back.Empty
      then
        with DrawRect.mir do
          BitBlt(Buffer.Canvas.Handle, LineLeft, Y, LineRight - LineLeft,
            Options.Margins.Space, Back.Canvas.Handle, 0, Y, Buffer.Canvas.CopyMode)
      else
        with Buffer.Canvas, DrawRect.mir do begin
          if Brush.Style <> bsSolid
          then Brush.Style:= bsSolid;
          if Brush.Color <> Options.Colors.Menu
          then Brush.Color:= Options.Colors.Menu;
          Buffer.Canvas.FillRect(Rect(LineLeft, Y, LineRight,
            Y + Options.Margins.Space));
        end;
    // increment Y
    Inc(Y, Options.Margins.Space);
  end;
  Dec(Y, Options.Margins.Space);
  // final paintings
  if fsPaintMenu in State then
    with Buffer, Canvas, DrawRect.mir do begin
      if Brush.Style <> bsSolid
      then Brush.Style:= bsSolid;
      if Brush.Color <> Options.Colors.Menu
      then Brush.Color:= Options.Colors.Menu;
      // fill top rect
      R:= Rect(0, 0, Buffer.Width, Border + Options.Margins.Top);
      FillRect(R);
      // fill bottom rect
      R.Top:= Y;
      R.Bottom:= Buffer.Height +1;
      FillRect(R);
      // fill left border
      R:= Rect(0, 0, LineLeft, Buffer.Height);
      FillRect(R);
      // fill right border
      R.Left:= LineRight;
      R.Right:= Buffer.Width +1;
      FillRect(R);
      // draw bottom background's part
      if (Y < Buffer.Height) then begin
        // draw bottom background's part
        if not Options.Background.Empty then
          BitBlt(Handle, DrawRect.mir.LineLeft, Y,
            DrawRect.mir.LineRight - DrawRect.mir.LineLeft, Buffer.Height - Y,
            Options.Background.Canvas.Handle, 0, Y, Buffer.Canvas.CopyMode);
      end;
      // paint frame
      Font:= Self.Font;
      R:= ClipRect;
      if (BorderStyle = bsNone)
      and (fsCtl3D in State)
      then DrawEdge(Handle, R, bdr_RaisedInner + bdr_RaisedOuter, bf_Rect);
      // paint title
      if Options.Title.Visible
      then Options.Title.Paint(Buffer.Canvas);
    end;
  // draw hidden arrow
  if (fsHiddenArrow in State)
  and ((fsPaintMenu in State)
    or (((fsSelectedChanged in State)
        or (fsMouseChanged in State))
      and ((SelectedIndex = itHiddenArrow)
        or (LastSelectedIndex = itHiddenArrow))))
  then
    with Buffer, Canvas do begin
      R:= Rect(DrawRect.mir.LineLeft, Height - DrawRect.mir.Border -13,
        DrawRect.mir.LineRight, Height - DrawRect.mir.Border - Options.Margins.Bottom);
      if SelectedIndex = itHiddenArrow
      then begin
        DrawPatternBackground(Canvas, R);
        if msLeftButton in MouseState
        then DrawEdge(Canvas.Handle, R, bdr_SunkenOuter, bf_Rect)
        else DrawEdge(Canvas.Handle, R, bdr_RaisedInner, bf_Rect);
      end
      else begin
        Brush.Style:= bsSolid;
        Brush.Color:= Options.Colors.Menu;
        FillRect(R);
      end;
      // draw arrow
      X:= (R.Right + R.Left) div 2 -3;
      Y:= (R.Top + R.Bottom) div 2 -4;
      if (SelectedIndex = itHiddenArrow)
      and (msLeftButton in MouseState) then begin
        Inc(X); Inc(Y);
      end;
      Pen.Color:= Options.Colors.MenuText;
      PolyLine([Point(X, Y), Point(X +2, Y +2), Point(X +4, Y), Point(X +4, Y +1), Point(X +2, Y +3),
        Point(X -1, Y)]);
      Inc(Y, 4);
      PolyLine([Point(X, Y), Point(X +2, Y +2), Point(X +4, Y), Point(X +4, Y +1), Point(X +2, Y +3),
        Point(X -1, Y)]);
    end;
  // restore palette
  if OldPalette <> 0
  then SelectPalette(Buffer.Canvas.Handle, OldPalette, True);
  // determine buffer's position & draw the buffer
  if fsFromBottomToTop in State then Y:= 0 else Y:= Buffer.Height - Height;
  if fsFromRightToLeft in State then X:= 0 else X:= Buffer.Width - Width;
  if (BorderStyle <> bsNone) then Inc(Y, ClientOrigin.Y - Top -20);
  BitBlt(Canvas.Handle, 0, 0, Buffer.Width, Buffer.Height, Buffer.Canvas.Handle, X, Y, Canvas.CopyMode);
  Exclude(State, fsPaintMenu);
  Exclude(State, fsMouseChanged);
  LastSelectedIndex:= SelectedIndex;
end;
procedure TPopupMenu2000Form.RebuildToolTipWindow(Recreate: Boolean);
  // set tooltips
var
  R: TRect;
  M: TMenuItem;
  X, Y, H, I, iI, iJ, Index, BW, BH: Integer;
begin
  // we have to recreate tooltip window if it became
  // floating
  ToolTipWindow.Free;
  ToolTipWindow:= nil;
  if (not PopupMenu.ShowHint)
  or (PopupMenu.StatusBar <> nil)
  then Exit;
  ToolTipWindow:= T_AM2000_ToolTipWindow.Create(Self);
  // init X
  X:= 0;
  if Options.Title.Visible
  and (Options.Title.Align = atLeft)
  then Inc(X, Options.Title.Width);
  // init Y
  Y:= Options.Margins.Top;
  if (BorderStyle = bsNone)
  then
    if (fsCtl3D in State)
    then begin Inc(X, Options.Margins.Border +2); Inc(Y, Options.Margins.Border +2); end
    else begin Inc(X, Options.Margins.Border); Inc(Y, Options.Margins.Border); end;
  // is menu draggable?
  if (Options.Draggable)
  and (BorderStyle = bsNone)
  then begin
    ToolTipWindow.AddTool(Rect(2, Y, MX -2, Y+9), SDraggableMenuInfo);
    Inc(Y, 10);
  end;
  // add tools to the ToolTip control
  for I:= 0 to ItemRects.Count -1 do begin
    M:= GetMenuItemIndex(I, False);
    H:= GetMenuItemHeightIndex(I);
    if (M <> nil) then
      // is it a button array?
      if (M is TMenuItem2000)
      and (TMenuItem2000(M).Control = ctlButtonArray)
      then
        with TMenuItem2000(M).AsButtonArray do begin
          if Bitmap.Empty then Continue;
          // init loop
          iI:= 0;
          iJ:= 0;
          Index:= 0;
          BW:= Bitmap.Width div Columns;
          BH:= Bitmap.Height div Rows;
          // assign each hint to tooltip control
          while Index < Hints.Count do begin
            R:= Rect(iI * BW + X +2, iJ * BH + Y +1, 0, 0);
            R.Right:= R.Left + BW;
            R.Bottom:= R.Top + BH;
            if Hints[Index] <> ''
            then ToolTipWindow.AddTool(R, Hints[Index]);
            // next step
            Inc(Index);
            Inc(iI);
            if iI = Columns
            then begin Inc(iJ); iI:= 0; end;
          end;
        end
      else
      // is hint present?
      if (M.Hint <> '') and (M.Hint <> #1)
      then
        ToolTipWindow.AddTool(Rect(0, Y, MX, Y+H), M.Hint);
    Inc(Y, H + Options.Margins.Space);
  end;
  // hidden arrow
  if (fsHiddenArrow in State)
  then ToolTipWindow.AddTool(Rect(0, Y, MX, MY), SExpand);
  ToolTipWindow.Activate;
end;
procedure TPopupMenu2000Form.RebuildBounds;
var
  I, DI1, DI2, H, P, W1, W2, MIC, W11, P11: Integer;
  M: TMenuItem;
  L: LongRec;
  S: String;
  IncludeBold: Boolean;
  procedure SetDefault(D: Boolean);
  begin
    with Buffer.Canvas.Font do
      if D then begin
        if not (fsBold in Style) then begin
          IncludeBold:= True;
          Style:= Style + [fsBold];
        end;
      end
      else
        if IncludeBold then begin
          IncludeBold:= False;
          Style:= Style - [fsBold];
        end;
  end;
begin
  // initialize
  P:= 0;
  M:= nil;
  I:= 0;
  DI1:= 0; // for invisible items
  DI2:= 0; // for hidden items
  W2:= 0;
  ItemWidth:= 0;
  ShortcutWidth:= 0;
  IncludeBold:= False;
  FiLeft:= 0;
  FiWidth:= 0;
  Exclude(State, fsHiddenArrow);
  ItemRects.Clear;
  if (MenuHandle = 0) or (Options = nil)
  then Exit;
  MIC:= GetMenuItemCount(MenuHandle);
  // start
  // calc top margin
  H:= Options.Margins.Top + Options.Margins.Border;
  if (BorderStyle = bsNone) then begin
    if (fsCtl3D in State)
    then begin Inc(H, Options.Margins.Border +2); Inc(FiLeft, Options.Margins.Border +2); end
    else begin Inc(H, Options.Margins.Border); Inc(FiLeft, Options.Margins.Border); end;
    // is menu draggable?
    if (Options.Draggable)
    then Inc(H, 9);
  end
  else
    Inc(H, 1);
  // calc all menu items
  while MIC > I + DI2 do begin
    L.Lo:= H;
    L.Hi:= 0;
    // calc item's heigth
    // Delphi menu item
    while (MenuItems.Count > I + DI1 + DI2) do begin
      M:= MenuItems[I + DI1 + DI2];
      // invisible item
      if (not M.Visible)
      then
        Inc(DI1)
      else
      // hidden item
      if (M is TMenuItem2000)
      and (TMenuItem2000(M).Hidden)
      and (not (fsShowHidden in State))
      then
        Inc(DI2)
      else
      // visible item
      begin
        L.Hi:= GetMenuItemHeight(M);
        // create new font style
        SetDefault(M.Default);
        S:= M.Caption;
        Break;
      end;
    end;
    if (MenuItems.Count <= I + DI1 + DI2) then M:= nil;
    // WinAPI menu item
    if M = nil then begin
      mii.fMask:= miim_Type;
      mii.dwTypeData:= Z;
      mii.cch:= SizeOf(Z) -1;
      if GetMenuItemInfo(MenuHandle, I + DI2, True, mii)
      then
        if (I = 0)
        and (DI2 <> 0)
        and (mii.fType and mft_Separator <> 0)
        then begin
          Inc(I);
          Continue;
        end
        else begin
          if mii.fType and mft_Separator <> 0
          then L.Hi:= Options.SeparatorHeight
          else L.Hi:= Options.ItemHeight;
          SetDefault(mii.fState and mfs_Default <> 0);
          S:= StrPas(Z);
        end;
    end;
    // add item's top and botton
    if L.Hi <> 0 then begin
      ItemRects.Add(Pointer(L));
      Inc(H, L.Hi + Options.Margins.Space);
      Inc(I);
    end;
    // calc item's caption width
    W1:= 0;
    if (M <> nil)
    and (M is TMenuItem2000)
    then begin
      W1:= TMenuItem2000(M).GetWidth(Buffer.Canvas);
      if W1 > 0 then Dec(W1, Options.Margins.Left + Options.Margins.Right);
    end;
    if W1 = 0 then begin
      P:= Pos(#9, S);
      if P <> 0 then S:= Copy(S, 1, P -1);
      // calc menu item's width
      repeat
        P11:= Pos('n', S);
        if P11 = 0 then P11:= Pos(#13, S);
        if P11 = 0 then P11:= Length(S) +1;
        if (S = '') or (P11 = 0) then Break;
        W11:= AmpTextWidth(Buffer.Canvas, Copy(S, 1, P11 -1));
        if W11 > W1 then W1:= W11;
        if (P11 < Length(S))
        and (S[P11] = #13)
        then Delete(S, 1, P11)
        else Delete(S, 1, P11 +1);
      until S = '';
    end;
    if ItemWidth < W1 then ItemWidth:= W1;
    // end caption width
    // calc item's shortcut width
    if (M <> nil)
    then
      if (M is TMenuItem2000)
      then begin
        if TMenuItem2000(M).ShortCut <> ''
        then W2:= Buffer.Canvas.TextWidth(GetMainShortCut(TMenuItem2000(M).ShortCut))
      end
      else
      if M.ShortCut <> 0
      then
        W2:= Buffer.Canvas.TextWidth(ShortCutToText(M.ShortCut));
    if P <> 0
    then W2:= Buffer.Canvas.TextWidth(Copy(Z, P +1, MaxInt));
    if ShortcutWidth < W2
    then ShortcutWidth:= W2;
    // end shortcut width
    // merge max caption width and max shrtcut width
    // office-like align (align shortcuts to the left)
    if not (mfStandardAlign in Options.Flags) then begin
      if W2 > 0 then Inc(W2, 4);
      if (FiWidth < W1 + W2) then FiWidth:= W1 + W2;
    end;
    
  end { loop for each menu item };
  // restore default canvas settings
  SetDefault(False);
  // merge max caption width and max shortcut width
  // standard align (align shortcuts to the right)
  if (mfStandardAlign in Options.Flags) then begin
    FiWidth:= ItemWidth + ShortCutWidth;
    if ShortCutWidth > 0 then Inc(FiWidth, 4);
  end;
  // add margins
  Inc(FiWidth, Options.Margins.Left + Options.Margins.Right);
  // add title
  with Options.Title do
    if (ParentMenuForm = nil)
    and Visible
    and (Align = atLeft)
    then Inc(FiLeft, Width);
  // set flag for hidden menu items
  if DI2 > 0
  then Include(State, fsHiddenArrow);
  // check menu with hidden menu items
  // and without unhidden menu items
  if (I = 0) and (DI2 > 0) then begin
    Include(State, fsShowHidden);
    RebuildBounds;
  end;
end;
function TPopupMenu2000Form.GetItemRect(Index: Integer): TRect;
begin
  if (Index >= 0) and (Index < ItemRects.Count) then begin
    Result.Left:=   FiLeft;
    Result.Top:=    LongRec(ItemRects[Index]).Lo;
    Result.Right:=  Result.Left + FiWidth;
    Result.Bottom:= Result.Top + LongRec(ItemRects[Index]).Hi;
  end
  else
    FillChar(Result, SizeOf(TRect), 0);
end;
procedure TPopupMenu2000Form.wmInitState;
var
  HiddenIsVisible: Boolean;
begin
  FormStyle:= fsStayOnTop;
  BorderStyle:= bsNone;
  HiddenIsVisible:= (fsShowHidden in State);
  if (PopupMenu = nil) then Exit;
  
  if HiddenIsVisible
  then PopupMenu.Options.Flags:= PopupMenu.Options.Flags + [mfHiddenIsVisible];
  // set Ctl3D
  if (PopupMenu.Ctl3D)
  then State:= [fsCtl3d]
  else State:= [];
  // assign options property
  GetOptions(MenuItems, PopupMenu, Options);
  // for submenus these properties
  // already initialized in CreateSubMenuForm
  if ParentMenuForm = nil
  then Animation:= Options.Animation;
  // hidden
  if HiddenIsVisible
  or (mfHiddenIsVisible in Options.Flags)
  then Include(State, fsShowHidden);
  // reassign font handle
  if PopupMenu.ParentFont
  then Font:= TForm(PopupMenu.Owner).Font
  else
  if PopupMenu.SystemFont
  then Font.Handle:= GetMenuFontHandle
  else Font:= PopupMenu.Font;
  Canvas.Font.Assign(Font);
  Buffer.Canvas.Font.Assign(Font);
  // get menu item height
  if PopupMenu.SystemFont
  then ItemHeight:= Canvas.TextHeight('Hj') +5
  else ItemHeight:= Options.ItemHeight;
end;
end.

						