Delphi控件源码

开发平台：
C++ Builder

am2000menubar.pas：源码内容
							
{*******************************************************}
{                                                       }
{       AnimatedMenus/2000                              }
{       TMenuBar2000                                    }
{                                                       }
{       Copyright (c) 1997-99 AnimatedMenus.com         }
{       All rights reserved.                            }
{                                                       }
{       Redesigned and improved by Victor Santos        }
{                                                       }
{*******************************************************}
unit am2000menubar;
{$I am2000.inc}
interface
uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, Menus,
  ComCtrls, ExtCtrls,
  am2000utils, am2000options, am2000hintwindow, am2000popupmenu;
type
  T_AM2000_aiState = (aiFlat, aiRaised, aiSunken);
  T_AM2000_SystemButtonPressed = (sbNone, sbMinimize, sbRestore, sbClose);
  T_AM2000_NextMenuItemParam = (niBackward, niIgnoreInvisible, niStopOnLimit);
  T_AM2000_NextMenuItemParams = set of T_AM2000_NextMenuItemParam;
  T_AM2000_mbType =(mbHorizontal, mbVertical, mbFloating);
  PMenuItemRect = ^TMenuItemRect;
  TMenuItemRect = record
    mi: TMenuItem;
    iR: TRect;
  end;
  TCustomMenuBar2000 = class(TCustomControl)
  private
    OwnerForm, LastChild: TForm;
    FMenu: TMenu;
    Buffer, Back: TBitmap;
    BufferState, DisableMouseUp, DisableAltKeyUp, WindowActive, KeepSelected: Boolean;
    FOptions, FLocalOptions: T_AM2000_Options;
    FPopupMenu: TCustomPopupMenu2000;
    SaveMenuTextColor: TColor;
    ToolTipWindow: T_AM2000_ToolTipWindow;
    FSBPanelNo: Integer;
    FStatusBar: TStatusBar;
    Lastai: TMenuItem;
    ai: TMenuItem;
    aiIndex: Integer;
    SystemButtonPressed: T_AM2000_SystemButtonPressed;
    SystemMenu: TMenuItem;
    ASTimer: TTimer;
    IgnorePaint: Boolean;
    FAlignParent  : Boolean;
    FSystemFont   : Boolean;
    FSystemFontHandle, FOldFontHandle: HFont;
    FOnMenuCommand   : TNotifyEvent;
    FOnMenuClose     : TNotifyEvent;
    FOnCloseQuery    : TCloseQueryEvent;
    FHotTrack: Boolean;
    FTransparent: Boolean;
    procedure SetAlignParent(Value: Boolean);
    procedure SetMenu(Value: TMenu);
    procedure SetOptions(Value: T_AM2000_Options);
    procedure SetSystemFont(Value: Boolean);
    procedure SetTransparent(Value: Boolean);
    procedure RebuildToolTipWindow;
    procedure wmWindowPosChanged(var Msg: TMessage); message wm_WindowPosChanged;
    procedure wmSetKeepSelected(var Msg: TMessage);  message wm_SetKeepSelected;
    procedure wmUpdateMenuBar(var Msg: TMessage);    message wm_UpdateMenuBar;
    procedure wmActivateMenuBar(var Msg: TMessage);  message wm_ActivateMenuBar;
    procedure cmMouseLeave(var Msg: TMessage);       message cm_MouseLeave;
    procedure cmIsToolControl(var Msg: TMessage);    message cm_IsToolControl;
    procedure wmSysKeyDown(var Msg: TWMKeyDown);     message wm_SysKeyDown;
    procedure wmSysKeyUp(var Msg: TWMKeyUp);         message wm_SysKeyUp;
    procedure wmKeyDown(var Msg: TWMKeyDown);        message wm_KeyDown;
    procedure wmMouseMove(var Msg: TWMMouse);        message wm_MouseMove;
{$IFDEF Delphi3OrHigher}
    procedure cmSysFontChanged(var Msg: TMessage);   message cm_SysFontChanged;
{$ENDIF}
    procedure wmSettingChange(var Msg: TMessage);    message wm_SettingChange;
    procedure cmFontChanged(var Msg: TMessage);      message cm_FontChanged;
    function GetMenuItemCount: Integer;
    function GetMenuItem(Index: Integer): TMenuItem;
    function GetNextMenuItem(var CurIndex: Integer; Params: T_AM2000_NextMenuItemParams): TMenuItem;
    procedure MoveActiveTo(NewItem: TMenuItem);
    procedure MoveActiveToIndex(NewIndex: Integer; NewItem: TMenuItem);
    function GetBitmapWidth(Item: TMenuItem): Integer;
    procedure PopupMenuXY(X, Y: Integer; SetHidden, SelectFirst: Boolean);
    procedure PopupMenuRect(R: TRect; SetHidden, SelectFirst: Boolean);
    function GetSysBtnRect(SysBtn : T_AM2000_SystemButtonPressed): TRect;
    function GetMenuIconRect: TRect;
    procedure TimerShow(Sender: TObject);
    procedure SetHotTrack(const Value: Boolean);
  protected
    procedure Paint; override;
    procedure Loaded; override;
    function GetBufOffsetX: Integer;
    function PtInRect2(const R: TRect; P: TPoint): Boolean;
    function GetItemSize(Item: TMenuItem): TSize;
    procedure PaintItem(Canvas: TCanvas; Item: TMenuItem;
                        R: TRect; BitBlt2SelfCanvas: Boolean);
    procedure PaintActiveItem;
    procedure PaintSystemButton(R: TRect; Letter: Char; Down, Enabled: Boolean);
    procedure PaintSystemButtons;
    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 DblClick; override;
    procedure CreateParams(var Params: TCreateParams); override;
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
    property PopupMenu       : TCustomPopupMenu2000
      read FPopupMenu write FPopupMenu;
    property AlignParent     : Boolean
      read FAlignParent write SetAlignParent default False;
    property HotTrack        : Boolean
      read FHotTrack write SetHotTrack default False;
    property Transparent     : Boolean
      read FTransparent write SetTransparent default False;
    property OnMenuCommand   : TNotifyEvent
      read FOnMenuCommand write FOnMenuCommand;
    property OnMenuClose     : TNotifyEvent
      read FOnMenuClose write FOnMenuClose;
    property OnCloseQuery    : TCloseQueryEvent
      read FOnCloseQuery write FOnCloseQuery;
  public
    aiState: T_AM2000_aiState;
    aiRect: TRect;
    mbType: T_AM2000_mbType;
    miRects: TList;
    miSysBtnRect: TRect;
    ParentClientWidth: Integer;
    property StatusBar       : TStatusBar
      read FStatusBar write FStatusBar;
    property StatusBarIndex  : Integer
      read FSBPanelNo write FSBPanelNo;
    property Options         : T_AM2000_Options
      read FOptions write SetOptions;
    property Menu            : TMenu
      read FMenu write SetMenu;
    property SystemFont      : Boolean
      read FSystemFont write SetSystemFont default True;
    property Font;
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure SetBounds(ALeft, ATop, AWidth, AHeight: Integer); override;
    procedure ResetBuffer;
    procedure PopupActiveItem(SelectFirst: Boolean);
    procedure SetActiveItemIndex(Index: Integer);
    procedure KillActiveItem;
    procedure HideActiveItem;
    procedure UpdateMenuBar(RebuildMenu: Boolean);
    procedure SetDisableAltKeyUp(Value: Boolean);
    function GetOffsetX: Integer;
    function GetLastOffsetX: Integer;
{$IFDEF Delphi4OrHigher}
    procedure InitiateAction; override;
{$ENDIF}
    procedure DoLoaded;
  end;
const
  iSystemIconWidth: Integer = 16;
  ActiveMenuBar   : TCustomMenuBar2000 = nil;
procedure AddMiRects(List : TList; MenuItem : TMenuItem; R : TRect);
procedure RemoveMiRects(List : TList; MenuItem : TMenuItem);
procedure ClearMiRects(List : TList);
function GetMiRect(List : TList; mI : Integer; MenuItem : TMenuItem) : TRect;
implementation
uses
  am2000menuitem, am2000mainmenu;
procedure AddMiRects(List : TList; MenuItem : TMenuItem; R : TRect);
var
  miRect: PMenuItemRect;
begin
     if (List <> nil) then begin
        New(miRect);
        if miRect <> nil then
        with miRect^ do begin
           mi:= MenuItem;
           iR:= R;
           List.Add(miRect);
        end;
     end;
end;
procedure RemoveMiRects(List : TList; MenuItem : TMenuItem);
var miRect: PMenuItemRect;
    i: Integer;
begin
     if (List <> nil) then
        for i:= 0 to List.Count-1 do begin
            miRect := PMenuItemRect(List.Items[i]);
            if miRect.mi = MenuItem then begin
               Dispose(miRect);
               List.Delete(i);
               Exit;
            end;
        end;
end;
procedure ClearMiRects(List : TList);
var miRect: PMenuItemRect;
    i: Integer;
begin
     if (List <> nil) then begin
        for i:= 0 to List.Count-1 do begin
            miRect := PMenuItemRect(List.Items[i]);
            Dispose(miRect);
        end;
        List.Clear;
     end;
end;
function GetMiRect(List : TList; mI : Integer; MenuItem : TMenuItem) : TRect;
var i: Integer;
begin
     Result := Rect(0,0,0,0);
     if (List <> nil) then
     with List do
       if (mI >= 0) and (mI < Count) and
          (PMenuItemRect(Items[mI])^.mi = MenuItem) then
          Result := PMenuItemRect(Items[mI])^.iR
       else
       { find the menuitem: }
       for i:= 0 to Count -1 do
          if PMenuItemRect(Items[i])^.mi = MenuItem then begin
             Result := PMenuItemRect(Items[i])^.iR;
             Exit;
          end;
end;
function CheckForHidden(Item: TMenuItem): Boolean;
var
  I: Integer;
begin
  Result:= False;
  if (Item = nil) then Exit;
  for I:= 0 to Item.Count -1 do
    if (Item is TMenuItem2000) then
      with TMenuItem2000(Item[I]) do
        if Hidden
        or ((Count > 0) and CheckForHidden(Item[I]))
        then begin
          Result:= True;
          Exit;
        end;
end;
{ TCustomMenuBar2000 }
constructor TCustomMenuBar2000.Create;
var
  O1: TComponent;
begin
  inherited;
  // control style
  ControlStyle := [csClickEvents, csDoubleClicks, csSetCaption, csOpaque,
    csReplicatable {$IFDEF Delphi4OrHigher}, csActionClient{$ENDIF}];
  // create the buffer
  Buffer:= TBitmap.Create;
  WindowActive:= True;
  FSystemFont:= True;
  ParentFont:= False;
  SystemMenu:= TMenuItem2000.Create(Self);
  ASTimer:= TTimer.Create(Self);
  ASTimer.Enabled:= False;
  ASTimer.Interval:= 3000;
  ASTimer.OnTimer:= TimerShow;
  // init menu item options
  FOptions:= T_AM2000_Options.Create;
  FLocalOptions:= T_AM2000_Options.Create;
  with FLocalOptions, Margins do begin
    Alignment:= taCenter;
    Left:= 0;
    Right:= 0;
    Top:= 0;
    Bottom:= 0;
  end;
  Width:= 50;
  Height:= 21;
  Align:= alTop;
  if ActiveMenuBar = nil
  then ActiveMenuBar:= Self;
  mbType:= mbHorizontal;
  miRects:= TList.Create;
  OwnerForm:= nil;
  O1:= AOwner;
  while (O1 <> nil) and (not (O1 is TForm)) do O1:= O1.Owner;
  if O1 is TForm then OwnerForm:= TForm(O1);
end;
destructor TCustomMenuBar2000.Destroy;
begin
  if ActiveMenuBar = Self
  then ActiveMenuBar:= nil;
  RemoveCWHooks;
  Buffer.Free;
  Back.Free;
  FOptions.Free;
  FLocalOptions.Free;
  PopupMenu.Free;
  ToolTipWindow.Free;
  ClearMiRects(miRects);
  miRects.Free;
  inherited;
end;
procedure TCustomMenuBar2000.CreateParams(var Params: TCreateParams);
begin
  inherited CreateParams(Params);
  with Params do
    WindowClass.Style:= WindowClass.Style and not (CS_HREDRAW or CS_VREDRAW);
end;
procedure TCustomMenuBar2000.Loaded;
begin
  inherited;
  // grab OwnerForm's menu
  if (OwnerForm is TForm) then begin
    if FMenu = nil
    then FMenu:= TForm(OwnerForm).Menu;
    if (FMenu = TForm(OwnerForm).Menu)
    then TForm(OwnerForm).Menu:= nil;
  end;
  // initialize other properties
  if not (csDesigning in ComponentState) then begin
    SaveMenuTextColor:= Options.Colors.MenuText;
    PopupMenu:= TCustomPopupMenu2000.Create(OwnerForm);
    InstallCWHooks;
    RebuildToolTipWindow;
    FLocalOptions.Assign(FOptions);
    with FLocalOptions, Margins do begin
      Alignment:= taCenter;
      Left:= 0;
      Right:= 0;
      Top:= 0;
      Bottom:= 0;
    end;
  end;
  if (Buffer.Empty)
  then SetBounds(Left, Top, 0, 0);
end;
{ Windows Messages Handlers }
procedure TCustomMenuBar2000.wmWindowPosChanged(var Msg: TMessage);
begin
  Invalidate;
  inherited;
end;
procedure TCustomMenuBar2000.wmUpdateMenuBar(var Msg: TMessage);
  // updates menu bar
const
  RebuildFlag: Boolean = False;
var
  M: TMsg;
begin
  // force menu merge rebuild
  if (Menu is TCustomMainMenu2000)
  and ((Msg.wParam = upForceRebuild)
  or ((Msg.wParam = upChildChanged)
  and (TForm(OwnerForm).ActiveMdiChild <> LastChild)))
  then begin
    TCustomMainMenu2000(Menu).RebuildMergedMenuItems;
    RebuildFlag:= True;
  end;
  // child changed
  if not AssignedActivePopupMenu2000Form
  then begin
    if (Msg.wParam = upChildChanged) // is child changed?
    then
      if (TForm(OwnerForm).ActiveMdiChild = LastChild)
      then begin
        if LastChild = nil
        then
           Msg.wParam:= 0
        else
           Msg.wParam:= WPARAM(LastChild.WindowState =
                               TForm(OwnerForm).ActiveMdiChild.WindowState);
      end
      else
        LastChild:= TForm(OwnerForm).ActiveMdiChild;
    // skip update on other messages
    if PeekMessage(M, Handle, wm_UpdateMenuBar, wm_UpdateMenuBar, pm_NoRemove)
    then begin
      RebuildFlag:= RebuildFlag or (M.wParam <> 0);
      Msg.Result:= 1;
      Exit;
    end;
    RebuildFlag:= RebuildFlag or (Msg.wParam <> 0);
    if RebuildFlag
    then begin
      UpdateMenuBar(True);
      RebuildFlag:= False;
    end
    else begin
      ResetBuffer;
      Paint;
    end;
  end;
end;
procedure TCustomMenuBar2000.PopupMenuXY(X, Y: Integer; SetHidden, SelectFirst: Boolean);
  // pops up menu
var
  P: TPoint;
begin
  // if active item is not active
  if not ((ai <> nil) and ai.Enabled)
  then Exit;
  // popup menu 98
  PopupMenu.MenuItems:= nil;
  P:= ClientToScreen(Point(X, Y));
  // switch between different cases of activeitem
  if (ai <> nil)
  then begin
    // OnClick event
    if Assigned(ai.OnClick)
    then ai.OnClick(ai); 
    // main system menu
    if (ai = SystemMenu)
    then begin
      PopupMenu.MenuItems:= nil;
      PopupMenu.MenuHandle:= GetSystemMenu(TForm(OwnerForm).ActiveMdiChild.Handle, False);
    end
    else
    // attached menu
    if (ai is TMenuItem2000)
    and (TMenuItem2000(ai).AttachMenu <> nil)
    then
      with TMenuItem2000(ai).AttachMenu as TCustomPopupMenu2000 do begin
        if Items.Count = 0 then InitItems(True);
        PopupMenu.MenuItems:= Items2000; // ordinal item
        PopupMenu.MenuHandle:= Items2000.Handle;
      end
    else
    // normal submenu
    if ai.Count > 0
    then begin
      PopupMenu.MenuItems:= ai; // ordinal item
      PopupMenu.MenuHandle:= ai.Handle;
    end
    // ordinary item
    else begin
      DisableMouseUp:= False;
      if KeepSelected then HideActiveItem;
      Exit;
    end;
      
  end
  else
    // child's system menu
    if (TForm(OwnerForm).FormStyle = fsMdiForm)
    and (TForm(OwnerForm).ActiveMdiChild <> nil)
    then PopupMenu.MenuHandle:= GetSystemMenu(TForm(OwnerForm).ActiveMdiChild.Handle, False);
  PopupMenu.Options.Assign(Options);
  PopupMenu.StatusBar:= StatusBar;
  PopupMenu.StatusBarIndex:= StatusBarIndex;
  PopupMenu.ShowHint:= ShowHint;
  PopupMenu.PopupComponent:= Self;
  PopupMenu.OnMenuCommand:= OnMenuCommand;
  PopupMenu.OnMenuClose:= OnMenuClose;
  PopupMenu.OnCloseQuery:= OnCloseQuery;
  PopupMenu.SystemFont:= SystemFont;
  PopupMenu.Font:= Font;
  PopupMenu.Ctl3D:= Ctl3D;
  // set selected first
  if KeepSelected or SelectFirst
  then PopupMenu.SetSelectedIndex(True);
  KeepSelected:= False;
  // set hidden flag
  ASTimer.Enabled:= False;
  if SetHidden
  then
    PopupMenu.Options.Flags:= PopupMenu.Options.Flags + [mfHiddenIsVisible]
  else
    // is hidden properties present then enable time
    if (not (mfNoAutoShowHidden in Options.Flags))
    and CheckForHidden(ai)
    then ASTimer.Enabled:= True;
  with PopupMenu do
{$IFDEF Delphi4OrHigher}
    Images:= Menu.Images;
{$ELSE}
    if (Menu is TCustomMainMenu2000)
    then Images:= TCustomMainMenu2000(Menu).Images
    else Images:= nil;
{$ENDIF}
  PopupMenu.Popup(P.X, P.Y);
  Lastai:= ai;
end;
procedure TCustomMenuBar2000.PopupMenuRect(R: TRect; SetHidden, SelectFirst: Boolean);
var X, Y: Integer;
begin
     if mbType = mbVertical then begin
        X:= R.Right +1;
        Y:= R.Top -1;
     end
     else begin
        if Options.Alignment = taRightToLeft
        then X:= R.Right + GetBufOffsetX
        else X:= R.Left;
        Y:= R.Bottom;
     end;
     PopupMenuXY(X, Y, SetHidden, SelectFirst);
end;
function TCustomMenuBar2000.GetSysBtnRect(SysBtn : T_AM2000_SystemButtonPressed): TRect;
  // get rect for system button
begin
  if SysBtn = sbNone then
    Result := Rect(0, 0, 0, 0)
  else begin
    // get close button rect
    if mbType = mbHorizontal
    then
      Result:= Rect(Width - iSystemIconWidth -1,
         Height - iSystemIconWidth -2,
         Width -1,
         Height -2)
    else
      Result:= Rect(miSysBtnRect.Right - iSystemIconWidth,
        miSysBtnRect.Bottom - iSystemIconWidth,
        miSysBtnRect.Right,
        miSysBtnRect.Bottom);
    case SysBtn of
      sbRestore:
        if mbType = mbVertical
        then
          OffsetRect(Result, 0, -iSystemIconWidth)
        else
          OffsetRect(Result, -iSystemIconWidth -2, 0);
      sbMinimize:
        if mbType = mbVertical then
          OffsetRect(Result, 0, -iSystemIconWidth*2 +2)
        else
          OffsetRect(Result, -iSystemIconWidth*2 -2, 0);
    end;
  end;
end;
function TCustomMenuBar2000.GetMenuIconRect: TRect;
var X, Y: Integer;
begin
     if GetOffsetX = 0 then
        Result := Rect(0, 0, 0, 0)
     else begin
        if mbType = mbVertical then begin
           X:= Width - iSystemIconWidth -1;
           Y:= 2;
        end
        else begin
           if Options.Alignment = taRightToLeft
           then X:= Buffer.Width - iSystemIconWidth -3
           else X:= 3;
           Y:= 2;
        end;
        Result := Rect(X, Y, X + iSystemIconWidth, Y + iSystemIconWidth);
     end;
end;
function TCustomMenuBar2000.PtInRect2(const R: TRect; P: TPoint): Boolean;
begin
  Dec(P.X, GetBufOffsetX);
  Result:= PtInRect(R, P);
end;
procedure TCustomMenuBar2000.wmSetKeepSelected(var Msg: TMessage);
begin
  KeepSelected:= Msg.wParam <> 0;
end;
procedure TCustomMenuBar2000.wmActivateMenuBar(var Msg: TMessage);
begin
  WindowActive:= Msg.wParam <> 0;
  if not WindowActive
  then HideActiveItem
  else ActiveMenuBar:= Self;
  PostMessage(Handle, wm_UpdateMenuBar, upNothing, 0);
end;
procedure TCustomMenuBar2000.wmSysKeyDown(var Msg: TWMKeyDown);
var
  I: Integer;
  Item: TMenuItem;
  UseFirstLetter: Boolean;
begin
  // if menu state is active
  if aiState <> aiFlat then begin
    SetDisableAltKeyUp(True);
    KillActiveItem;
    Msg.Result:= 1;
  end
  else
  // show child system menu
  if (Msg.CharCode = VK_SUBTRACT)
  and (TForm(OwnerForm).FormStyle = fsMdiForm)
  and (TForm(OwnerForm).ActiveMdiChild <> nil)
  and (TForm(OwnerForm).ActiveMdiChild.WindowState = wsMaximized)
  then begin
    aiRect.Left:= 0;
    ai:= SystemMenu;
    PopupActiveItem(True);
    Msg.Result:= 1;
  end
  // shortcut
  else
  if (Msg.CharCode <> VK_MENU)
  and (Msg.CharCode <> VK_F10)
  and (FMenu <> nil)
  then begin
    UseFirstLetter:= True;
    repeat
      UseFirstLetter:= not UseFirstLetter;
      for I:= 0 to GetMenuItemCount -1 do begin
        Item:= GetMenuItem(I);
        // if item is visible
        if (Item <> nil)
        and Item.Visible
        // and accelerator pressed
        and IsAccelEx(Msg.CharCode, Item.Caption, UseFirstLetter)
        then begin
          MoveActiveToIndex(I, Item);
          SetDisableAltKeyUp(True);
          PopupActiveItem(True);
          Msg.Result:= 1;
          Exit;
        end;
      end;
    until UseFirstLetter;
  end;
end;
procedure TCustomMenuBar2000.wmSysKeyUp(var Msg: TWMKeyUp);
begin
  if (Menu <> nil)
  and (aiState = aiFlat)
  and ((Msg.CharCode = vk_Menu) or (Msg.CharCode = vk_F10))
  and not DisableAltKeyUp
  then begin
    FullHideCaret;
    KeepSelected:= True;
    aiState:= aiSunken;
    SetCursor(LoadCursor(0, MakeIntResource(idc_Arrow)));
    if ai = nil
    then begin
      if (TForm(OwnerForm).FormStyle = fsMdiForm)
      and (TForm(OwnerForm).ActiveMdiChild <> nil)
      then ai:= SystemMenu
      else ai:= GetMenuItem(0);
      MoveActiveToIndex(0, ai);
    end
    else begin
      PaintActiveItem;
    end;
  end;
  Msg.Result:= 1;
  SetDisableAltKeyUp(False);
end;
procedure TCustomMenuBar2000.wmKeyDown(var Msg: TWMKeyDown);
  // handles basic cursor movements and menu shortcuts
var
  M: TMsg;
  procedure SearchForMergedMenus;
  var
    I: Integer;
  begin
    if IsShortCutEx(Msg, Menu.Items, csDesigning in ComponentState)
    then Exit;
    I:= 1;
    if (Menu is TCustomMainMenu2000) then
      with TCustomMainMenu2000(Menu) do
        while (Msg.Result = 0) and (I < MergedMenus.Count) do begin
          if IsShortCutEx(Msg, TMainMenu(MergedMenus[I]).Items, csDesigning in ComponentState)
          then Exit;
          Inc(I);
        end;
  end;
  function IsShortCut: Boolean;
    // checks is this is a shortcut
  begin
    Result:= (Msg.CharCode <> vk_Control)
      and (Msg.CharCode <> vk_Shift)
      and ((GetKeyState(vk_Control) < 0)
      or (Msg.KeyData and AltMask <> 0)
      or ((Msg.CharCode >= vk_F1) and (Msg.CharCode <= vk_F12))
      or (Msg.CharCode = vk_Escape)
      or (Msg.CharCode = vk_Delete)
      or (Msg.CharCode = vk_Insert)
      or (Msg.CharCode = vk_Back));
  end;
begin
  if (aiState = aiSunken) then
    case Msg.CharCode of
      // open menu
      vk_Return, vk_Space, vk_Down, vk_Up:
        if not TCustomPopupMenu2000(PopupMenu).FormOnScreen then begin
          PopupMenuRect(aiRect, False, True);
          Msg.Result:= 1;
        end;
      // move selection left or right
      vk_Tab:
        begin
          KeepSelected:= True;
          if GetKeyState(vk_Shift) < 0
          then
             MoveActiveTo(GetNextMenuItem(aiIndex, [niBackward, niIgnoreInvisible]))
          else
             MoveActiveTo(GetNextMenuItem(aiIndex, [niIgnoreInvisible]));
          KeepSelected:= False;
          Msg.Result:= 1;
        end;
      // move selection left
      vk_Right:
        begin
          KeepSelected:= True;
          MoveActiveTo(GetNextMenuItem(aiIndex, [niIgnoreInvisible]));
          KeepSelected:= False;
          Msg.Result:= 1;
        end;
      // move selection right
      vk_Left:
        begin
          KeepSelected:= True;
          MoveActiveTo(GetNextMenuItem(aiIndex, [niBackward, niIgnoreInvisible]));
          KeepSelected:= False;
          Msg.Result:= 1;
        end;
      // escape
      vk_Escape:
        begin
          KillActiveItem;
          Msg.Result:= 1;
        end;
      vk_F1:
        if (Application.HelpFile <> '')
        and (ai <> nil)
        and (ai.HelpContext <> 0)
        then begin
          KillActivePopupMenu2000(True, False);
          if (OwnerForm is TForm)
          and (biHelp in TForm(OwnerForm).BorderIcons)
          then Application.HelpCommand(HELP_CONTEXTPOPUP, ai.HelpContext)
          else Application.HelpCommand(HELP_CONTEXT, ai.HelpContext);
          // We have to remove the next message that is in the queue.
          PeekMessage(M, 0, 0, 0, pm_Remove);
          Msg.Result:= 1;
        end;
    end
  else
    if IsShortCut
    then SearchForMergedMenus;
end;
procedure TCustomMenuBar2000.wmMouseMove(var Msg: TWMMouse);
begin
  inherited;
  if (ToolTipWindow <> nil)
  then ToolTipWindow.RelayMouseMove(Msg.Pos);
end;
{ Set Bounds Routines }
function TCustomMenuBar2000.GetOffsetX: Integer;
begin
  Result:= 0;
  if OwnerForm = nil then Exit;
  // is system icon present?
  with OwnerForm as TForm do
    if (ActiveMdiChild <> nil)
    and (ActiveMdiChild.WindowState = wsMaximized)
    then Inc(Result, iSystemIconWidth +4);
end;
function TCustomMenuBar2000.GetLastOffsetX: Integer;
begin
  Result:= 0;
  if OwnerForm = nil then Exit;
  // increase by mdi caption buttons
  with OwnerForm as TForm do
    if (ActiveMdiChild <> nil)
    and (ActiveMdiChild.WindowState = wsMaximized)
    then begin
      if mbType <> mbVertical
      then Inc(Result, 4);
      // if Form is an MDI form, and it's ActiveMdiForm property
      // is not nil and the child form is maximized
      // then add caption buttons' width and space width
      if (biMaximize in ActiveMdiChild.BorderIcons)
      or (biMinimize in ActiveMdiChild.BorderIcons)
      then begin
        Inc(Result, iSystemIconWidth *2);
        if mbType <> mbVertical then Inc(Result, 2);
      end;
      if (biSystemMenu in ActiveMdiChild.BorderIcons)
      then Inc(Result, iSystemIconWidth);
    end;
end;
function TCustomMenuBar2000.GetBufOffsetX: Integer;
begin
  if (Options.Alignment = taRightToLeft)
  then Result:= Width - Buffer.Width - GetLastOffsetX
  else Result:= 0;
end;
function TCustomMenuBar2000.GetItemSize(Item: TMenuItem): TSize;
var
  W: Integer;
  S: String;
begin
  Result.Cx:= 0;
  Result.Cy:= 0;
  if (Item = nil) then Exit;
  S:= StripAmpersands(Item.Caption);
  // select font
  if FSystemFont then begin
    if FSystemFontHandle = 0 then FSystemFontHandle:= GetMenuFontHandle;
    FOldFontHandle:= SelectObject(Buffer.Canvas.Handle, FSystemFontHandle);
  end
  else
    Buffer.Canvas.Font.Assign(Font);
  GetTextExtentPoint32(Buffer.Canvas.Handle, PChar(S), Length(S), Result);
  // if bitmap present...
  W:= GetBitmapWidth(Item);
  if W > 0 then Inc(Result.CX, W);
end;
function TCustomMenuBar2000.GetMenuItemCount: Integer;
begin
  if FMenu = nil
  then Result:= 0
  else
  if FMenu is TCustomMainMenu2000
  then Result:= TCustomMainMenu2000(FMenu).MergedMenuItemsCount
  else Result:= FMenu.Items.Count;
end;
function TCustomMenuBar2000.GetMenuItem(Index: Integer): TMenuItem;
begin
  if FMenu = nil
  then Result:= nil
  else
  if FMenu is TCustomMainMenu2000
  then Result:= TCustomMainMenu2000(FMenu).MergedMenuItems[Index]
  else Result:= FMenu.Items[Index];
end;
function TCustomMenuBar2000.GetNextMenuItem(var CurIndex: Integer; Params: T_AM2000_NextMenuItemParams): TMenuItem;
  // returns nearest menu item
var
  SaveIndex: Integer; // prevents looping
  CurItem: TMenuItem;
  Maximized: Boolean;
begin
  SaveIndex:= CurIndex;
  Result:= nil;
  Maximized:= (TForm(OwnerForm).ActiveMdiChild <> nil)
    and (TForm(OwnerForm).ActiveMdiChild.WindowState = wsMaximized);
  repeat
    if niBackward in Params
    then Dec(CurIndex)
    else Inc(CurIndex);
    // check right limit
    if (CurIndex >= GetMenuItemCount) then begin
      if (niStopOnLimit in Params) then Exit;
      if Maximized then begin
        CurIndex:= -1;
        Result:= SystemMenu;
        Exit;
      end;
      CurIndex:= 0;
    end;
    // check left limit
    if (CurIndex < 0) then begin
      if (niStopOnLimit in Params) then Exit;
      if Maximized and (CurIndex = -1) then begin
        Result:= SystemMenu;
        Exit;
      end;
      CurIndex:= GetMenuItemCount -1;
    end;
    // check for looping
    if (CurIndex = SaveIndex)
    then Exit;
    CurItem:= GetMenuItem(CurIndex);
  until (CurItem <> nil) and (CurItem.Visible or (not (niIgnoreInvisible in Params)));
  Result:= CurItem;
end;
{ Drawing Rountines }
procedure TCustomMenuBar2000.PaintItem(Canvas: TCanvas; Item: TMenuItem;
                                       R: TRect; BitBlt2SelfCanvas: Boolean);
  procedure PaintHorizontal(Canvas: TCanvas; R: TRect; DrawBackground: Boolean);
  var
    DX, DY: Integer;
  begin
    if FSystemFont
    then begin
      SelectObject(Canvas.Handle, FOldFontHandle);
      Canvas.Font.Handle:= FSystemFontHandle;
      FOldFontHandle:= SelectObject(Canvas.Handle, FSystemFontHandle);
    end;
    if (ai = Item)
    and (aiState = aiSunken)
    and Ctl3D
    then DX:= 1
    else DX:= 0;
    if mbType = mbVertical
    then DY:= -DX
    else DY:= DX;
    if (Item <> nil) then begin
      DrawRect.Item:= Item;
      // is it necessary to re-init DrawRect?
      if DrawRect.Canvas <> Canvas then begin
        DrawRect.mir.Clear;
        DrawRect.State:= [];
        DrawRect.Canvas:= Canvas;
        DrawRect.Options:= FLocalOptions;
{$IFDEF Delphi4OrHigher}
        DrawRect.Images:= TImageList(Menu.Images);
{$ELSE}
        if (Menu is TCustomMainMenu2000)
        then DrawRect.Images:= TCustomMainMenu2000(Menu).Images;
{$ENDIF}
      end;
      with DrawRect do begin
        mir.BitmapLeft:= R.Left + DX +4;
        mir.BitmapWidth:= GetBitmapWidth(Item);
        mir.LineLeft:= R.Left + DX;
        mir.LineRight:= R.Right + DX;
        mir.ItemLeft:= R.Left + DX;
        if mir.BitmapWidth > 0
        then Inc(mir.ItemLeft, mir.BitmapWidth);
        mir.ItemWidth:= mir.LineRight - mir.ItemLeft;
        mir.Top:= R.Top + DY;
        mir.Height:= R.Bottom - R.Top;
        // is Ctl3d is false then highlight menu item
        if (ai = Item)
        and (aiState <> aiFlat)
        and not Ctl3D
        then Include(State, isSelected)
        else Exclude(State, isSelected);
        // Transparent background
        if DrawBackground
        then Include(State, isGraphBack)
        else Exclude(State, isGraphBack);
        // draw item
        DrawMenuItem(@DrawRect);
      end;
    end;
  end;
  procedure PaintVertical(Canvas: TCanvas; R: TRect);
  var
    bmp: TBitmap;
    procedure PaintRotated;
    var
      W, X, Y: Integer;
      P, T: TColor;
    begin
      W:= bmp.Height;
      T:= bmp.Canvas.Pixels[bmp.Width -1, W -1];
      for X:= 0 to bmp.Width -1 do
        for Y:= 0 to bmp.Height -1 do begin
          P:= bmp.Canvas.Pixels[X, Y];
          if P <> T
          then Canvas.Pixels[R.Left + W-Y -1, R.Top + X]:= P;
        end;
    end;
  begin
    if (Item <> nil) then begin
      bmp:= TBitmap.Create;
      try
         bmp.Width:= R.Bottom - R.Top;
         bmp.Height:= R.Right - R.Left;
         PaintHorizontal(bmp.Canvas, Rect(0,0,bmp.Width,bmp.Height), True);
         PaintRotated;
      finally
         bmp.Free;
      end;
    end;
  end;
begin
  // Transparent background
  if FTransparent
  then
    BitBlt(Canvas.Handle, R.Left, R.Top, R.Right - R.Left +1, R.Bottom - R.Top +1,
      Back.Canvas.Handle, R.Left, R.Top, SrcCopy);
  if mbType = mbVertical then
    PaintVertical(Canvas, R)
  else
    PaintHorizontal(Canvas, R, FTransparent);
  if (ai = Item) then
    if Ctl3D then
      case aiState of
        aiRaised: DrawEdge(Canvas.Handle, R, bdr_RaisedInner, bf_Rect);
        aiSunken: DrawEdge(Canvas.Handle, R, bdr_SunkenOuter, bf_Rect);
        aiFlat:   Canvas.FrameRect(R);
      end
    else
      Canvas.FrameRect(R);
  if BitBlt2SelfCanvas
  then
    with R do begin
      // paint background
      // bitblt with a mask
      BitBlt(Self.Canvas.Handle, Left + GetBufOffsetX, Top, Right - Left, Bottom - Top,
        Canvas.Handle, Left, Top, SrcCopy);
    end;
end;
procedure TCustomMenuBar2000.PaintActiveItem;
begin
  if (ai <> SystemMenu)
  then PaintItem({$IFNDEF DrawOnCanvas}Buffer.{$ENDIF}Canvas, ai, aiRect, True);
end;
procedure TCustomMenuBar2000.ResetBuffer;
begin
  Canvas.Brush.Style:= bsClear;
  Canvas.Brush.Bitmap:= nil;
  BufferState:= False;
  Buffer.FreeImage;
end;
procedure TCustomMenuBar2000.PaintSystemButton(R: TRect; Letter: Char; Down, Enabled: Boolean);
  // draw system button
const
  dt_Flags = dt_Center + dt_VCenter + dt_SingleLine;
  Edge: array [Boolean] of UINT = (Edge_Raised, Edge_Sunken);
  ButtonColors: array [Boolean] of TColor = (clBtnText, clGrayText);
begin
  Canvas.Brush.Style:= bsSolid;
  Canvas.Brush.Color:= Options.Colors.Menu;
  Canvas.FillRect(R);
  DrawEdge(Canvas.Handle, R, Edge[Down], bf_Soft + bf_Rect);
  if Down then OffsetRect(R, 1, 1);
  InflateRect(R, -1, -1);
  if Canvas.Brush.Style <> bsClear
  then Canvas.Brush.Style:= bsClear;
  Canvas.Font.Name:= 'Marlett';
  Canvas.Font.Height:= iSystemIconWidth -6;
  if not Enabled then begin
    Canvas.Font.Color:= clBtnHighlight;
    OffsetRect(R, 1, 1);
    DrawText(Canvas.Handle, @Letter, 1, R, dt_Flags);
    OffsetRect(R, -1, -1);
    Canvas.Font.Color:= clGrayText;
  end
  else
    if Canvas.Font.Color <> clBtnText
    then Canvas.Font.Color:= clBtnText;
  DrawText(Canvas.Handle, @Letter, 1, R, dt_Flags);
end;
procedure TCustomMenuBar2000.PaintSystemButtons;
var
  F: TForm;
  R: TRect;
begin
  // fill the background
  R:= miSysBtnRect;
  InflateRect(R, 1, 1);
  
{  if FTransparent then begin
    BitBlt(Canvas.Handle, R.Left, R.Top, R.Right - R.Left, R.Bottom - R.Top,
      Back.Canvas.Handle, R.Left, R.Top, SrcCopy);
  end
  else begin
    Canvas.FillRect(R);
  end;
}
  // draw
  F:= TForm(OwnerForm);
  if (F <> nil)
  and (F.ActiveMdiChild <> nil)
  and (F.ActiveMdiChild.WindowState = wsMaximized)
  then
    with F.ActiveMdiChild do begin
      { close }
      R:= GetSysBtnRect(sbClose);
      PaintSystemButton(R, 'r', SystemButtonPressed = sbClose, True);
      if (biMaximize in BorderIcons) or (biMinimize in BorderIcons) then begin
        { restore }
        R:= GetSysBtnRect(sbRestore);
        PaintSystemButton(R, '2', SystemButtonPressed = sbRestore,
                                        biMaximize in BorderIcons);
        { minimize }
        R:= GetSysBtnRect(sbMinimize);
        PaintSystemButton(R, '0', SystemButtonPressed = sbMinimize,
                                         biMinimize in BorderIcons);
      end;
    end;
end;
procedure TCustomMenuBar2000.Paint;
var
  F: TForm;
  R: TRect;
  I, DX: Integer;
  CurItem: TMenuItem;
begin
  if (csLoading in ComponentState)
  or (csDestroying in ComponentState)
  or IgnorePaint
  then Exit;
  R:= Rect(0, 0, 0, 0);
  if not WindowActive
  then FLocalOptions.Colors.MenuText:= Options.Colors.DisabledText
  else FLocalOptions.Colors.MenuText:= SaveMenuTextColor;
  // if the buffer is empty...
  if (not BufferState)
  and (GetMenuItemCount > 0)
  then
    with {$IFNDEF DrawOnCanvas} Buffer, {$ENDIF}Canvas do begin
      if FTransparent then begin
        BitBlt(Handle, 0, 0, Self.Width +2, Self.Height +2, Back.Canvas.Handle, Self.Left, Self.Top, SrcCopy);
      end
      else begin
        Brush.Style:= bsSolid;
        Brush.Color:= FLocalOptions.Colors.Menu;
        FillRect(ClipRect);
      end;
      // if Form is MDI and ChildForm is assigned man maximized
      F:= TForm(OwnerForm);
      if (F <> nil)
      and (F.ActiveMdiChild <> nil)
      and (F.ActiveMdiChild.WindowState = wsMaximized)
      then begin
        R:= GetMenuIconRect;
        PaintMenuIcon(F, F.ActiveMdiChild, Handle, R.Left, R.Top, iSystemIconWidth);
      end;
      // draw menu items
      if ai = SystemMenu
      then aiRect:= R;
      if (FMenu <> nil) then
        for I:= 0 to GetMenuItemCount -1 do begin
          CurItem:= GetMenuItem(I);
          if (CurItem = nil)
          or (not CurItem.Visible)
          then Continue;
          R := GetMiRect(miRects, I, CurItem);
          PaintItem(Canvas, CurItem, R, {$IFDEF DrawOnCanvas}True{$ELSE}False{$ENDIF});
          if CurItem = ai
          then aiRect:= R;
        end;
      aiRect.Bottom:= R.Bottom;
    end;
  BufferState:= True;
  if (Options.Alignment = taRightToLeft)
  then DX:= Width - Buffer.Width - GetLastOffsetX
  else DX:= 0;
{$IFNDEF DrawOnCanvas}
  BitBlt(Canvas.Handle, DX, 0, Buffer.Width, Buffer.Height, Buffer.Canvas.Handle, 0, 0, SrcCopy);
{$ENDIF}
  // fill the rest
  if FTransparent then begin
    if mbType = mbVertical
    then begin
      if Buffer.Height < Height
      then BitBlt(Canvas.Handle, 0, Buffer.Height, Width +1, Height +1, Back.Canvas.Handle, 0, Buffer.Height, SrcCopy);
    end
    else
    if Buffer.Width < Width
    then
      if Options.Alignment = taRightToLeft
      then BitBlt(Canvas.Handle, 0, 0, DX, Height +1, Back.Canvas.Handle, 0, 0, SrcCopy)
      else BitBlt(Canvas.Handle, Buffer.Width, 0, Width +1, Height +1, Back.Canvas.Handle, Buffer.Width, 0, SrcCopy);
  end
  else begin
    Canvas.Brush.Style:= bsSolid;
    Canvas.Brush.Color:= Options.Colors.Menu;
    if mbType = mbVertical
    then begin
      if Buffer.Height < Height
      then Canvas.FillRect(Rect(0, Buffer.Height, Width +1, Height +1))
    end
    else
    if Buffer.Width < Width
    then
      if Options.Alignment = taRightToLeft
      then Canvas.FillRect(Rect(0, 0, DX, Height +1))
      else Canvas.FillRect(Rect(Buffer.Width, 0, Width +1, Height +1));
  end;
  // draw caption buttons
  PaintSystemButtons;
end;
procedure TCustomMenuBar2000.SetBounds(ALeft, ATop, AWidth, AHeight: Integer);
  procedure OrderMenuItems(var bWidth, bHeight: Integer);
  var
    iW,iH, i: Integer;
    rSize, bX,bY: Integer;
  begin
    rSize:= 0;
    if (Parent <> nil)
    then
      case mbType of
        mbVertical:   rSize:= Parent.ClientHeight;
        mbHorizontal: rSize:= Parent.ClientWidth;
        mbFloating:   rSize:= ParentClientWidth;
      end
    else
      rSize:= High(rSize);
    if rSize < 0 then Exit;
    for i:=0 to miRects.Count -1 do begin
      with PMenuItemRect(miRects.Items[i])^ do
        iW:= iR.Right-iR.Left;
      if rSize < iW then rSize:= iW;
    end;
    // offsets
    if rSize < GetOffsetX     then rSize:= GetOffsetX;
    // start
    bX:= GetOffsetX;
    bY:= 0;
    iH:= 0;
    bWidth:= 0;
    bHeight:= 0;
    for I:= 0 to miRects.Count -1 do
       with PMenuItemRect(miRects.Items[i])^ do begin
         iW:= iR.Right-iR.Left;
         iH:= iR.Bottom-iR.Top;
         if i=0 then bHeight:= iH +1;
         if (bX + iW) > rSize then begin
           Inc(bY, iH +1);
           Inc(bHeight, iH +1);
           bX:= 0;
         end;
         iR:= Rect(bX, bY, bX + iW, bY + iH);
         Inc(bX, iW);
         if bX > bWidth then bWidth:= bX;
       end;
    // sys buttons
    iW:= GetLastOffsetX;
    if (bX + iW) > rSize then begin
      Inc(bY, iH +2);
      Inc(bHeight, iH +1);
      bX:= 0;
    end;
    Inc(bX, iW);
    if bX > bWidth then bWidth:= bX;
    if mbType = mbVertical
    then
      miSysBtnRect:= Rect(bY, bX - iW, bY + iH, bX)
    else
      miSysBtnRect:= Rect(bWidth - iW, bY, bWidth, bY + iH);
    // right-to-left reading
    if Options.Alignment = taRightToLeft
    then
      for I:= 0 to miRects.Count -1 do
        with PMenuItemRect(miRects.Items[i])^ do
          iR:= Rect(bWidth - iR.Right, iR.Top, bWidth - iR.Left, iR.Bottom);
  end;
var
  I, W, H: Integer;
  CurItem: TMenuItem;
  miX1, miY1, SaveIndex: Integer;
  DC: HDC;
begin
  W:= 0;
  H:= 0;
  iSystemIconWidth:= GetSystemMetrics(SM_CYMENUSIZE) -2;
  // calculating interior's width and height
  if (FMenu <> nil)
  and not (csLoading in ComponentState)
  then begin
    ClearMiRects(miRects);
    if mbType = mbVertical then begin
       miX1:= 0;
       miY1:= GetOffsetX;
    end
    else begin
       miX1:= GetOffsetX;
       miY1:= 0;
    end;
    // calculate menu items' width
    for I:= 0 to GetMenuItemCount -1 do begin
      CurItem:= GetMenuItem(I);
      if (CurItem <> nil)
      and CurItem.Visible
      then
        with GetItemSize(CurItem) do begin
          AddMiRects(miRects, CurItem, Rect(miX1, miY1, miX1 +(Cx +12), miY1 +(Cy +5)));
          Inc(miX1, Cx +12);
        end;
    end;
    OrderMenuItems(W, H);
    if mbType = mbVertical then
       for i:= 0 to miRects.Count -1 do
           with PMenuItemRect(miRects.Items[i])^ do
           iR:= Rect(H - iR.Bottom, iR.Left, H - iR.Top, iR.Right);
    // set minimal bounds
    if W = 0 then W:= 50;
    if H = 0 then H:= 10;
    if mbType = mbVertical then begin
      I:= W;
      W:= H;
      H:= I;
    end;
    // arranging buffer
    if Buffer.Width <> W then begin
      Buffer.Width:= W;
      ResetBuffer;
    end;
    if Buffer.Height <> H then begin
      Buffer.Height:= H;
      ResetBuffer;
    end;
    case mbType of
      mbFloating: begin
                    AWidth:= W;
                    AHeight:= H;
                  end;
      mbHorizontal: if (Parent <> nil) then begin
                       if Parent.ClientWidth < W then
                          AWidth:= W
                       else AWidth:= Parent.ClientWidth;
                       AHeight:= H;
                    end;
      mbVertical:   if (Parent <> nil) then begin
                       if Parent.ClientHeight < H then
                          AHeight:= H
                       else AHeight:= Parent.ClientHeight;
                       AWidth:= W;
                    end;
    end;
    // draw back
    if FTransparent
    and (Parent <> nil)
    then begin
      Back.Width:= AWidth;
      Back.Height:= AHeight;
      IgnorePaint:= True;
      DC:= Back.Canvas.Handle;
      with Parent do begin
        ControlState:= ControlState + [csPaintCopy];
        SaveIndex:= SaveDC(DC);
        MoveWindowOrg(DC, -Self.Left, -Self.Top);
        IntersectClipRect(DC, 0, 0, Width +1, Height +1);
        Perform(WM_ERASEBKGND, DC, 0);
        
        if not (csDesigning in ComponentState)
        then Perform(WM_PAINT, DC, 0);
        RestoreDC(DC, SaveIndex);
        ControlState:= ControlState - [csPaintCopy];
      end;
      IgnorePaint:= False;
    end;
    if (not (csDesigning in ComponentState))
    and FAlignParent
    and (Parent <> nil)
    then begin
      Parent.ClientHeight:= AHeight +3;
      Parent.ClientWidth:= AWidth +3;
      ALeft:= 1;
      ATop:= 1;
    end;
  end;
  // inherited
  inherited;
end;
procedure TCustomMenuBar2000.cmMouseLeave(var Msg: TMessage);
begin
  if (aiState = aiRaised)
  and not KeepSelected
  then HideActiveItem;
  ASTimer.Enabled:= False;
end;
procedure TCustomMenuBar2000.CMIsToolControl(var Msg: TMessage);
begin
  Msg.Result:= 1;
end;
{$IFDEF Delphi3OrHigher}
procedure TCustomMenuBar2000.cmSysFontChanged(var Msg: TMessage);
begin
  inherited;
  if FOldFontHandle <> 0 then begin
    SelectObject(Canvas.Handle, FOldFontHandle);
    DeleteObject(FSystemFontHandle);
    FSystemFontHandle:= 0;
    FOldFontHandle:= 0;
  end;
  UpdateMenuBar(True);
end;
{$ENDIF}
procedure TCustomMenuBar2000.wmSettingChange(var Msg: TMessage);
begin
  inherited;
  if FOldFontHandle <> 0 then begin
    SelectObject(Canvas.Handle, FOldFontHandle);
    DeleteObject(FSystemFontHandle);
    FSystemFontHandle:= 0;
    FOldFontHandle:= 0;
  end;
  UpdateMenuBar(True);
end;
procedure TCustomMenuBar2000.cmFontChanged(var Msg: TMessage);
begin
  inherited;
  UpdateMenuBar(True);
end;
{ Mouse movements } 
procedure TCustomMenuBar2000.MouseMove(Shift: TShiftState; X, Y: Integer);
const
  LastX: Integer = 0;
  LastY: Integer = 0;
var
  I: Integer;
  R: TRect;
  CurItem: TMenuItem;
begin
  inherited;
  // now active menu bar
  ActiveMenuBar:= Self;
  // ignore little movements
  if (FMenu = nil)
  or (not WindowActive)
  or ((Abs(X - LastX) <= 2)
  and (Abs(Y - LastY) <= 2))
  then Exit;
  LastX:= X;
  LastY:= Y;
  // activate tooltip window
  if (aiState = aiRaised)
  and (ToolTipWindow <> nil)
  then ToolTipWindow.Activate;
  if GetOffsetX > 0 then begin
     I:= -1;
     CurItem:= SystemMenu;
     R:= GetMenuIconRect;
     if PtInRect2(R, Point(X,Y)) then begin
       // don't redraw on duplicating
       if (ai = CurItem)
       and (aiState <> aiFlat)
       then Exit;
       MoveActiveToIndex(I, CurItem);
       Exit;
     end;
  end;
  // loop for each of menu items
  for I:= 0 to GetMenuItemCount -1 do begin
      CurItem:= GetMenuItem(I);
      if CurItem = nil then Continue;
      R:= GetMiRect(miRects, I, CurItem);
      if PtInRect2(R, Point(X,Y)) then begin
        // don't redraw on duplicating
        if (ai = CurItem)
        and (aiState <> aiFlat)
        then Exit;
        MoveActiveToIndex(I, CurItem);
        Exit;
      end;
  end;
  { paint System Buttons: }
  if SystemButtonPressed <> sbNone then begin
     R:= GetSysBtnRect(SystemButtonPressed);
     if not PtInRect(R, Point(X,Y)) then begin
       SystemButtonPressed:= sbNone;
       PaintSystemButtons;
       Exit;
     end;
  end;
  if aiState = aiRaised
  then KillActiveItem;
end;
procedure TCustomMenuBar2000.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
  P: TPoint;
  R: TRect;
  F: TForm;
begin
  inherited;
  // exit when other key
  if Button <> mbLeft then begin
    KillActivePopupMenu2000(True, False);
    Exit;
  end;
  // disable tooltip window
  if (ToolTipWindow <> nil)
  then ToolTipWindow.Deactivate;
  // disable menu item
  DisableMouseUp:= DisableMouseUp or
    ((aiState <> aiSunken) and (ai <> nil) and ai.Enabled);
  if (aiState = aiRaised)  then begin
    PopupActiveItem(False);
    Exit;
  end;
  // check for menu items
  F:= TForm(OwnerForm);
  if (F.ActiveMdiChild <> nil)
  and (F.ActiveMdiChild.WindowState = wsMaximized)
  then
    with F.ActiveMdiChild do begin
      P:= Point(X, Y);
      R:= GetSysBtnRect(sbClose);
      SystemButtonPressed:= sbNone;
      if PtInRect(R, P)
      then SystemButtonPressed:= sbClose;
      R:= GetSysBtnRect(sbRestore);
      if PtInRect(R, P)
      and (biMaximize in BorderIcons)
      then SystemButtonPressed:= sbRestore;
      R:= GetSysBtnRect(sbMinimize);
      if PtInRect(R, P)
      and (biMinimize in BorderIcons)
      then SystemButtonPressed:= sbMinimize;
      // if system button is pressed then kill opened
      // menu and repaint menu bar
      if SystemButtonPressed <> sbNone then begin
        KillActiveItem;
        Paint;
      end;
    end;
end;
procedure TCustomMenuBar2000.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
const
  SysCmd: array [T_AM2000_SystemButtonPressed] of UINT =
    (0, sc_Minimize, sc_Restore, sc_Close);
var
  F: TForm;
begin
  inherited;
  if Button <> mbLeft then Exit;
  // check for system buttons
  if (SystemButtonPressed <> sbNone) then begin
    F:= TForm(OwnerForm).ActiveMdiChild;
    if (F <> nil)
    then F.Perform(wm_SysCommand, SysCmd[SystemButtonPressed], 0);
    SystemButtonPressed:= sbNone;
    UpdateMenuBar(False);
    Exit;
  end;
  // ignore this mouse up event
  if DisableMouseUp then begin
    DisableMouseUp:= False;
    Exit;
  end;
  // menu item pressed
  if (aiState = aiSunken)
  then
    if (ai <> nil)
    then begin
      KillActiveItem;
      aiState:= aiRaised;
      PaintActiveItem;
    end
    else
      TForm(OwnerForm).ActiveMdiChild.Close;
end;
procedure TCustomMenuBar2000.HideActiveItem;
begin
  // remove hidden flag
  If (PopupMenu <> nil)
  then PopupMenu.RemoveShowHiddenFlag;
  // draw
  if aiState <> aiFlat then begin
     aiState:= aiFlat;
     PaintActiveItem;
  end;
  aiState:= aiFlat;
  DisableMouseUp:= False;
  KeepSelected:= False;
end;
procedure TCustomMenuBar2000.MoveActiveTo(NewItem: TMenuItem);
  // set new ActiveItem
var
  IsMenuOpened: Boolean;
  aaiState: T_AM2000_aiState;
begin
  if (NewItem = nil)
  or (csDestroying in ComponentState)
  then Exit;
  if ai <> NewItem
  then
    IsMenuOpened:= TCustomPopupMenu2000(PopupMenu).FormOnScreen
      or ((aiState = aiSunken) and (not KeepSelected))
      or FHotTrack
  else
    IsMenuOpened:= FHotTrack;
  if IsMenuOpened
  then KillActivePopupMenu2000(False, False);
  // draw new activeitem
  if (ai <> nil)
  and (ai <> SystemMenu)
  and (aiState <> aiFlat)
  then begin
     aaiState:= aiState;
     aiState:= aiFlat;
     PaintItem(Buffer.Canvas, ai, aiRect, True);
     aiState:= aaiState;
  end;
  ai:= NewItem;
  if (aiState = aiFlat)
  and (ai <> nil)
  and (ai.Enabled)
  then
    if FHotTrack
    then aiState:= aiSunken
    else aiState:= aiRaised;
  if ai = SystemMenu then
     aiRect:= GetMenuIconRect
  else
  if ai <> nil then begin
     aiRect := GetMiRect(miRects, aiIndex, ai);
     PaintItem(Buffer.Canvas, ai, aiRect, True);
  end;
  // if no item or no submenu
  if (ai.Count = 0)
  and (ai <> SystemMenu)
  and not ((ai is TMenuItem2000) and (TMenuItem2000(ai).AttachMenu <> nil))
  then Exit;
  // open submenu
  if (aiState = aiSunken)
  and IsMenuOpened
  then PopupMenuRect(aiRect, False, KeepSelected);
end;
procedure TCustomMenuBar2000.MoveActiveToIndex(NewIndex: Integer; NewItem: TMenuItem);
  // set new ActiveItem(ai) and ActiveItemIndex(aiIndex)
begin
  if NewItem = SystemMenu then
     NewIndex:= -1;
  aiIndex:= NewIndex;
  MoveActiveTo(NewItem);
  // set aiIndex
  if (ai = nil)
  then aiIndex:= -1
  else aiIndex:= NewIndex;
end;
procedure TCustomMenuBar2000.SetActiveItemIndex(Index: Integer);
begin
  if Index < GetMenuItemCount then
    MoveActiveToIndex(Index, GetMenuItem(Index));
end;
procedure TCustomMenuBar2000.PopupActiveItem(SelectFirst: Boolean);
begin
  if (ai <> nil)
  and ai.Enabled
  then aiState:= aiSunken;
  // repaint
  PaintActiveItem;
  // popup submenu
  PopupMenuRect(aiRect, False, SelectFirst);
end;
procedure TCustomMenuBar2000.KillActiveItem;
begin
  KillActivePopupMenu2000(True, False);
  FullShowCaret;
end;
{ Properties }
procedure TCustomMenuBar2000.SetAlignParent(Value: Boolean);
begin
  FAlignParent:= Value;
  UpdateMenuBar(False);
end;
procedure TCustomMenuBar2000.SetMenu(Value: TMenu);
begin
  FMenu:= Value;
  UpdateMenuBar(True);
end; 
procedure TCustomMenuBar2000.SetOptions(Value: T_AM2000_Options);
begin
  FOptions.Assign(Value);
end;
procedure TCustomMenuBar2000.SetSystemFont(Value: Boolean);
begin
  FSystemFont:= Value;
  if Value then ParentFont:= False;
  UpdateMenuBar(True);
end;
procedure TCustomMenuBar2000.UpdateMenuBar(RebuildMenu: Boolean);
var
  SaveIdx, Count: Integer;
begin
  if (csLoading in ComponentState)
  or (csDestroying in ComponentState)
  then Exit;
  if PopupMenu = nil
  then DoLoaded;
  // reset bounds
  if RebuildMenu then begin
    if ai <> nil
    then SaveIdx:= aiIndex
    else SaveIdx:= 0;
    // rebuild main menu
    if (FMenu is TCustomMainMenu2000)
    then TCustomMainMenu2000(FMenu).RebuildMergedMenuItems;
    // clear bounds
    SetBounds(Left, Top, 0, 0);
    Count:= GetMenuItemCount;
    if (Count > 0)
    and (SaveIdx >=0)
    and (SaveIdx < Count)
    then begin
      ai:= GetMenuItem(SaveIdx);
      aiIndex:= 0;
    end
    else begin
      ai:= nil;
      aiIndex:= -1;
    end;
    RebuildToolTipWindow;
  end;
  ResetBuffer;
  Paint;
end;
procedure TCustomMenuBar2000.RebuildToolTipWindow;
var
  I: Integer;
  R: TRect;
  CurItem: TMenuItem;
begin
  ToolTipWindow.Free;
  ToolTipWindow:= nil;
  if (not ShowHint)
  or (StatusBar <> nil)
  then Exit;
  // add tooltips
  ToolTipWindow:= T_AM2000_ToolTipWindow.Create(Self);
  R:= Rect(0, 0, 0, 0);
  for I:= 0 to GetMenuItemCount -1 do begin
    R.Left:= R.Right;
    CurItem:= GetMenuItem(I);
    if (CurItem = nil)
    or (not CurItem.Visible)
    then Continue;
    with GetItemSize(CurItem) do begin
      Inc(R.Right, Cx +12);
      R.Bottom:= R.Top + Cy +5;
    end;
    if (CurItem.Hint <> '')
    and (CurItem.Hint <> #1)
    and (ToolTipWindow <> nil)
    then ToolTipWindow.AddTool(R, CurItem.Hint);
  end;
end;
procedure TCustomMenuBar2000.Notification(AComponent: TComponent;
  Operation: TOperation);
begin
  inherited;
  // remove reference
  if (Operation = opRemove) then begin
    if (AComponent = FMenu) then SetMenu(nil);
    if (AComponent = FStatusBar) then FStatusBar:= nil;
  end;
  if (Operation = opInsert)
  and (AComponent is TMainMenu)
  and (FMenu = nil)
  then begin
    FMenu:= TMenu(AComponent);
    PostMessage(Handle, wm_UpdateMenuBar, 1, 0);
  end;
end;
procedure TCustomMenuBar2000.SetDisableAltKeyUp(Value: Boolean);
begin
  DisableAltKeyUp:= Value;
end;
function TCustomMenuBar2000.GetBitmapWidth(Item: TMenuItem): Integer;
begin
  Result:= 0;
  if (Item = nil) then Exit;
  if (Item is TMenuItem2000)
  and TMenuItem2000(Item).IsBitmapAssigned
  then
    Result:= TMenuItem2000(Item).Bitmap.Width +4
  // item index <> -1
  else
  if
{$IFNDEF Delphi4OrHigher}
  (Item is TMenuItem2000) and (TMenuItem2000(Item).ImageIndex <> -1)
{$ELSE}
  (Item.ImageIndex <> -1)
{$ENDIF}
  then begin
{$IFDEF Delphi4OrHigher}
    Result:= Menu.Images.Width;
{$ELSE}
    if (Menu is TCustomMainMenu2000)
    then Result:= TCustomMainMenu2000(Menu).Images.Width;
{$ENDIF}
  end
  // ordinal item
{$IFDEF Delphi4OrHigher}
  else
    if not Item.Bitmap.Empty
    then Result:= Item.Bitmap.Width +4;
{$ENDIF}
end;
procedure TCustomMenuBar2000.DblClick;
begin
  inherited;
  if (ai = SystemMenu)
  and (TForm(OwnerForm).ActiveMdiChild <> nil)
  then begin // close current child
    DisableMouseUp:= True;
    KillActiveItem;
    TForm(OwnerForm).ActiveMdiChild.Perform(wm_SysCommand, sc_Close, 0);
    Exit;
  end;
  if CheckForHidden(ai)
  and (not (mfNoAutoShowHidden in Options.Flags))
  then begin
    PopupMenuRect(aiRect, True, False);
    DisableMouseUp:= True;
  end;
end;
procedure TCustomMenuBar2000.TimerShow(Sender: TObject);
var
  P: TPoint;
begin
  ASTimer.Enabled:= False;
  if mfHiddenIsVisible in PopupMenu.Options.Flags
  then Exit;
  // check is mouse cursor still over menu bar
  GetCursorPos(P);
  if (aiState = aiSunken)
  and PtInRect(ClientRect, ScreenToClient(P))
  then PopupMenuRect(aiRect, True, False);
end;
{$IFDEF Delphi4OrHigher}
procedure TCustomMenuBar2000.InitiateAction;
var
  I: Integer;
  mi: TMenuItem;
begin
  if Menu <> nil then
    for I := 0 to GetMenuItemCount - 1 do begin
      mi:= GetMenuItem(I);
      if (mi <> nil)
      and (mi.Visible)
      then mi.InitiateAction;
    end;
end;
{$ENDIF}
procedure TCustomMenuBar2000.SetHotTrack(const Value: Boolean);
begin
  FHotTrack:= Value;
  KillActiveItem;
end;
procedure TCustomMenuBar2000.SetTransparent(Value: Boolean);
begin
  if FTransparent = Value then Exit;
  
  FTransparent:= Value;
  // create a bitmap
  if FTransparent
  then
    Back:= TBitmap.Create
  else begin
    Back.Free;
    Back:= nil;
  end;
  KillActiveItem;
  // update
  if csDesigning in ComponentState
  then UpdateMenuBar(False);
end;
procedure TCustomMenuBar2000.DoLoaded;
begin
  Loaded;
end;
initialization
finalization
//  ActiveMenuBar.Free;
end.

						