(************************************************************************
*    This File is Part of the AHM Triton Tools                          *
*    for Borland Delphi and C++ Builder.                                *
*************************************************************************
* Copyright © 1995-1999 Alexander H. Mehlhorn (AHM) and Tritontools.com *
* All Rights reserved.                                                  *
*                                                                       *
*    For more Information contact us at                                 *
*    E-Mail : support@tritontools.com                                   *
*    URL : http://www.tritontools.com                                   *
*                                                                       *
*    AHM is copyright by Alexander H. Mehlhorn                          *
*    All Parts of this Collection were developed,                       *
*    designed and implemented by AHM                                    *
*                                                                       *
*    Under no Circumstances may you distribute this file                *
*    in this or any other format. This File is supplied                 *
*    as Evaluation of Source only. No Delphi Components may be developed*
*    using extracts or subsets of this code without expressed permission*
*    by AHM.                                                            *
*                                                                       *
*************************************************************************)
unit AHMMenu;
interface
{$I AHM.INC}
{ 1.01 Thanks to Torry from Torry's Delphi Pages removed the drawing of disabled selected Items }
{ 1.02 Thanks to Torry from Torry's Delphi Pages fixed the flicker in selected Items }
{ 1.03 Removed Memory Exhaustion by not using permanent Images }
{ 1.04 speeded up the Item rendering using direct Canvas draws }
{ 1.05 Made the Selection Outline to be drawn on top of selected Item }
{ 1.06 Fixed Bug with New Styles }
{ 1.07 Included AsBitmaps into Old Styles }
{ 1.08 Fixed Problems with Shortcuts }
{ 1.09 Fixed Problem with Closing the Application under NT when MainMenu shown as Popup }
{ 1.10 Fixed Problem with Refresh in Design OnCreate }
{ 1.11 Added Glyph Preview in AHM Builder }
{ 1.12 Added Font Preview in AHM Builder }
{ 1.13 Added Test Button in AHMBuilder for Menu Preview }
{ 1.14 Fixed Problem with Hint in AHM Builder }
{ 1.15 Changed BarFonts to only Fontnames }
{ 1.16 Enhanced for compatibility across different versions of Delphi,C++Builder}
{ Release 1 }
{ 1.17 Fixed transparent Draw of Menu Images }
{ 1.18 Thanks to Mirko Boeer fixed the Bar Font Names to actually display something :) }
{ 1.19 Finally fixed the Design Time OnClick event to work now aswell }
{ 1.20 Thanks to Mirko Boeer fixed a problem with Windows Icons when drawing invalid Indexes from the Imagelist }
{ 1.21 Thanks to Mirko Boeer fixed added a Gradient Property to the Bar }
{ 1.22 Thanks to Mirko Boeer fixed Problem with the resetting of Image Indexes when changed }
{ 1.23 Added Drag-Drop Functionality to the Menu Builder for speedy Design }
{ 1.24 Changed the About box to directly link to my Homepage }
{ 1.25 Fixed Speed of drawing gradient bars }
{ 1.26 Fixed Drawing of the Imageindex to draw as disabled Images when the MenuItem is disabled and no DisabledImage is attached
  Thanks again to Mirko Boeer }
{ 1.27 Fixed Glyphchanges in MenuDesigner }
{ 1.28 Added Delphi 4.0 Support }
{ 1.29 Fixed Menus for Windows95 and Delphi 4.0 only Combination }
{ 1.30 Thanks to Gary Hanks Fixed a Problem with the Shortcuts (Gary supplied this code) }
{ 1.31 Thanks to Gary Hanks Fixed a Problem with the Measurements (Gary supplied this code) }
{ 1.32 Thanks to Mirko Boeer fixed the problem with the Context sensitive Help on Menuitems }
{ 1.33 Fixed Problem with Exception upon existence of a Delphi MainMenu }
{ 1.34 Added automatic conversion of Delphi Main Menus upon dropping the component }
{ 1.35 Fixed problem with Spacing on the Menubar}
{ 1.36 Resolved issue around the consts.pas unit reference}
{ 1.37 fixed issue with duplicate mainmenu}


uses Windows, SysUtils,Classes, Messages, Graphics,Dialogs,Menus,Controls,ShellApi,comctrls{$IFDEF AHMINPRISE4},ImgList,ACTNLIST{$ENDIF},AHMTMHkClass,DsgnIntf;
const
  scShift = $2000;
  scCtrl = $4000;
  scAlt = $8000;
  scNone = 0;
type
  EAHMMenuError = class(Exception);
  TAHMMenuItem = class;
  EDuplicateMainMenu=class(Exception);
  TAHMBackgroundType = (btCenter,btTiled);
  TAHMBarWidth = 1..40;
  TAHMBitmapItem = Class(TGraphicsObject)
  private
    FTransparentColor : TColor;
    FBitmap : TBitmap;
    FCaptionOnTop : Boolean;
    procedure SetBitmap(Value : TBitmap);
    procedure BitmapChange(Sender : TObject);
    procedure SetTransparentColor(Value : TColor);
    procedure SetCaptionOnTop(Value : Boolean);
  protected
  public
    Function HasBitmap : Boolean;
    constructor Create(AOwner : TComponent);
    Destructor Destroy; override;
  published
    property CaptionOnTop : Boolean read FCaptionOnTop write SetCaptionOnTop default false;
    property Bitmap : TBitmap read FBitmap write SetBitmap;
    property TransparentColor : TColor read FTransparentColor write SetTransparentColor default clNone;
  end;
  TAHMSubMenu = class;
  TAHMMenuGradient = class(TGraphicsObject)
  private
     FFadeToColor : TColor;
     FActive : Boolean;
     FColorCount : Byte;
     FOwner:TAHMSubMenu;
     Procedure SetFadeToColor(value : TColor);
     Procedure SetColorCount(Value : Byte);
     procedure SetActive(Value : Boolean);
  protected
  public
    constructor Create(Owner : TAHMSubMenu); virtual;
    Procedure Draw(const Cdc:HDC;iWidth,iHeight : Integer);
  published
    property Active : Boolean read FActive write SetActive default False;
    Property FadeToColor : TColor read FFadeToColor write SetFadeToColor default clBlack;
    Property ColorCount : Byte read FColorCount write SetColorCount default 32;
  end;
  TAHMSubMenu = Class(TGraphicsObject)
  private
    FOwnerMenu : TAHMMenuItem;
    FEnabled : Boolean;
    FBarBackground : TBitmap;
    FBarEnabled : Boolean;
    FParentComponent : TComponent;
    FBarCaption : String;
    FBarWidth : TAHMBarWidth;
    FBarColor : TColor;
    FBarFontName : String;
    FBarFontSize : Byte;
    FBarFontColor : TColor;
    FColor,FTransparentColor : TColor;
    FBackgroundType : TAHMBackgroundType;
    FBackground : TBitmap;
    FBarAsGradient : TAHMMenuGradient;
    procedure SetBackgroundType(Value : TAHMBackgroundType);
    procedure SetBackground(Value : TBitmap);
    procedure SetTransparentColor(Value : TColor);
    procedure SetColor(Value : TColor);
    procedure SetBarFontColor(value : TColor);
    procedure SetBarAsGradient(Value : TAHMMenuGradient);
    procedure SetBarFontSize(value : Byte);
    procedure SetBarFontName(Value : String);
    procedure SetBarColor(Value : TColor);
    procedure SetBarBackground(Value : TBitmap);
    procedure SubMenuChange(Sender : TObject);
    procedure SetBarWidth(Value : TAHMBarWidth);
    procedure SetBarEnabled(Value : Boolean);
    procedure SetBarCaption(Value : String);
    procedure SetEnabled(Value : Boolean);
  protected
    constructor Create(AOwner : TComponent;AHMMenu : TAHMMenuItem);
  published
    destructor Destroy; override;
    property BackgroundType : TAHMBackgroundType read FBackgroundType write SetBackgroundType default btTiled;
    property Background : TBitmap read FBackground write SetBackground stored true;
    property TransparentColor : TColor read FTransparentColor write SetTransparentColor default clNone;
    property Color : TColor read FColor write SetColor default clMenu;
    property Enabled : Boolean read FEnabled write SetEnabled default False;
    property BarEnabled : Boolean read FBarEnabled write SetBarEnabled default False;
    property BarBackground : TBitmap read FBarBackground write SetBarBackground stored True;
    property BarFontname : String read FBarFontName write SetBarFontName;
    property BarAsGradient : TAHMMenuGradient read FBarAsGradient write SetBarAsGradient;
    property BarFontSize : Byte read FBarFontSize write SetBarFontSize default 8;
    property BarFontColor : TColor read FBarFontColor write SetBarFontColor default clWindowText;
    property BarColor : TColor read FBarColor write SetBarColor default clNavy;
    property BarWidth : TAHMBarWidth read FBarWidth write SetBarWidth default 15;
    property BarCaption : String read FBarCaption write SetBarCaption;
  end;
  TAHMMenu = class;
  {$IFDEF AHMINPRISE4}
  TAHMMenuActionLink = class(TActionLink)
  protected
    FClient: TMenuItem;
    procedure AssignClient(AClient: TObject); override;
    function IsCaptionLinked: Boolean; override;
    function IsCheckedLinked: Boolean; override;
    function IsEnabledLinked: Boolean; override;
    function IsHelpContextLinked: Boolean; override;
    function IsHintLinked: Boolean; override;
    function IsImageIndexLinked: Boolean; override;
    function IsShortCutLinked: Boolean; override;
    function IsVisibleLinked: Boolean; override;
    function IsOnExecuteLinked: Boolean; override;
    procedure SetCaption(const Value: string); override;
    procedure SetChecked(Value: Boolean); override;
    procedure SetEnabled(Value: Boolean); override;
    procedure SetHelpContext(Value: THelpContext); override;
    procedure SetHint(const Value: string); override;
    procedure SetImageIndex(Value: Integer); override;
    procedure SetShortCut(Value: TShortCut); override;
    procedure SetVisible(Value: Boolean); override;
    procedure SetOnExecute(Value: TNotifyEvent); override;
  end;

  TAHMMenuActionLinkClass = class of TAHMMenuActionLink; {$ENDIF}

  TAHMMenuBreak = (mbNone, mbBreak, mbBarBreak);
  TAHMMenuChangeEvent = procedure (Sender: TObject;{$IFDEF AHMINPRISE4}Source : TMenuItem;{$ENDIF} Rebuild: Boolean) of object;
  TAHMSystemItem = (sicNone,sicRestore,sicMaximize,sicMinimize,sicSize,sicMove,sicClose,
                    sicContextHelp,sicTaskList,sicMonitorPower);
  TAHMMenuItem = class(TMenuItem)
  private
    FCaption: string;
    FHandle: HMENU;
    FEnabled: Boolean;
    FDefault: Boolean;
    FRadioItem: Boolean;
    FSubMenuDetails : TAHMSubMenu;
    FBreak: TAHMMenuBreak;
    FOnSelect : TNotifyEvent;
    FVisible: Boolean;
    FCommand: Word;
    FItems: TList;
    {$IFDEF AHMINPRISE4} FActionLink: TAHMMenuActionLink; {$ENDIF}
    FShortCut: TShortCut;
    FParent: TAHMMenuItem;
    FMerged: TAHMMenuItem;
    FMergedWith: TAHMMenuItem;
    FMenu: TAHMMenu;
    FHelpContext: THelpContext;
    FHint: string;
    FOnChange: TAHMMenuChangeEvent;
    FOnClick: TNotifyEvent;
    FImageIndex : Integer;
    FCheckedIndex : Integer;
    FDisabledImageIndex : Integer;
    FChecked : Boolean;
    FDivider : Boolean;
    FItemWidth,FItemHeight : Integer;
    FAsBitmapItem : TAHMBitmapItem;
    FSystemItem : TAHMSystemItem;
    FDestroy : Boolean;
    procedure SystemClick(Sender : TObject);
    procedure SetVisible(Value: Boolean);
    {$IFDEF AHMINPRISE4} procedure DoActionChange(Sender: TObject); {$ENDIF}
    Procedure SetSystemItem(Value : TAHMSystemItem);
    procedure SetAsBitmapItem(Value : TAHMBitmapItem);
    {$IFDEF AHMINPRISE4}
    function GetAction: TBasicAction;
    procedure SetAction(Value: TBasicAction);
    procedure InitiateActions;
    function IsCaptionStored: Boolean;
    function IsCheckedStored: Boolean;
    function IsEnabledStored: Boolean;
    function IsHelpContextStored: Boolean;
    function IsHintStored: Boolean;
    function IsImageIndexStored: Boolean;
    function IsOnClickStored: Boolean;
    function IsShortCutStored: Boolean;
    function IsVisibleStored: Boolean;
    {$ENDIF}
    procedure AppendTo(Menu: HMENU);
    procedure ClearHandles;
    procedure ReadShortCutText(Reader: TReader);
    procedure MergeWith(Menu: TAHMMenuItem);
    procedure RebuildHandle;
    procedure PopulateMenu;
    procedure SubItemChanged(Sender: TObject;{$IFDEF AHMINPRISE4}Source : TMenuItem;{$ENDIF} Rebuild: Boolean);
    procedure TurnSiblingsOff;
    procedure WriteShortCutText(Writer: TWriter);
    procedure VerifyGroupIndex(Position: Integer; Value: Byte);
    procedure SetImageIndex(Value : Integer);
    procedure SetCheckedIndex(Value : Integer);
    procedure SetDisabledImageIndex(Value : Integer);
    procedure SetDivider(Value : Boolean);
    procedure SubMenuChange(Sender : TObject);
  protected
    {$IFDEF AHMINPRISE4}
    procedure ActionChange(Sender: TObject; CheckDefaults: Boolean); override;
    function GetAHMActionLinkClass: TAHMMenuActionLinkClass; dynamic;
    procedure AssignTo(Dest: TPersistent); override;
    procedure Notification(AComponent: TComponent;
      Operation: TOperation); override;
    {$ENDIF}
    Function GetAHMMenu : TAHMMenu;
    procedure DefineProperties(Filer: TFiler); override;
    function GetHandle: HMENU;
    function GetCount: Integer;
    {$IFNDEF AHMINPRISE3}
     procedure GetChildren(Proc: TGetChildProc); override;
    {$ELSE}
     procedure GetChildren(Proc: TGetChildProc; Root: TComponent); override;
    {$ENDIF}
    function GetItem(Index: Integer): TAHMMenuItem;
    function GetMenuIndex: Integer;
    procedure MenuChanged(Rebuild: Boolean); override;
    procedure SetBreak(Value: TAHMMenuBreak);
    procedure SetMenuIndex(Value: Integer);
    procedure SetCaption(const Value: string);
    procedure SetChildOrder(Child: TComponent; Order: Integer); override;
    procedure SetDefault(Value: Boolean);
    procedure SetEnabled(Value: Boolean);
    procedure SetParentComponent(Value: TComponent); override;
    procedure SetRadioItem(Value: Boolean);
    procedure SetShortCut(Value: TShortCut);
    procedure DrawMenuItem(var ADrawItem : TWMDrawItem);
    procedure MeasureMenuItem(var AMeasureItem : TWMMeasureItem);
    Function ValidateType : Boolean;
    {$IFDEF AHMINPRISE4}
    property ActionLink: TAHMMenuActionLink read FActionLink write FActionLink;
    {$ENDIF}
  public
    {$IFDEF AHMINPRISE4}
    procedure InitiateAction; override;
    {$ENDIF}
    function HasParent: Boolean; override;
    function GetParentComponent: TComponent; override;
    Function GetSubSize : TPoint;
    Function HasImage : Boolean;
    Function ImageInMenuNoRoot : Boolean;
    constructor Create(AOwner: TComponent); override;
    procedure Loaded; override;
    destructor Destroy; override;
    procedure Insert(Index: Integer; Item: TAHMMenuItem);
    procedure Delete(Index: Integer);
    procedure Click; override;
    procedure SetChecked(Value: Boolean);
    function IndexOf(Item: TAHMMenuItem): Integer;
    procedure Add(Item: TAHMMenuItem);
    procedure Remove(Item: TAHMMenuItem);
    property Command: Word read FCommand;
    property Handle: HMENU read GetHandle;
    property Count: Integer read GetCount;
    property Parent: TAHMMenuItem read FParent;
    property Items[Index: Integer]: TAHMMenuItem read GetItem; default;
    property MenuIndex: Integer read GetMenuIndex write SetMenuIndex;
  published
    {$IFDEF AHMINPRISE4}
    property Action: TBasicAction read GetAction write SetAction;
    {$ENDIF}
    property HelpContext: THelpContext read FHelpContext write FHelpContext {$IFDEF AHMINPRISE4}Stored IsHelpContextStored{$ENDIF} default 0;
    property Hint: string read FHint write FHint {$IFDEF AHMINPRISE4} stored IsHintStored{$ENDIF};
    property SystemItem : TAHMSystemItem read FSystemItem write SetSystemItem default sicNone;
    property AsBitmapItem : TAHMBitmapItem read FAsBitmapItem write SetAsBitmapItem;
    property SubMenuDetails : TAHMSubMenu read FSubMenuDetails write FSubMenuDetails;
    property Divider : Boolean read FDivider write SetDivider default False;
    property Break: TAHMMenuBreak read FBreak write SetBreak default mbNone;
    property Caption: string read FCaption write SetCaption {$IFDEF AHMINPRISE4}Stored IsCaptionStored{$ENDIF};
    property Checked: Boolean read FChecked write SetChecked {$IFDEF AHMINPRISE4}Stored IsCheckedStored{$ENDIF} default False;
    property Visible: Boolean read FVisible write SetVisible {$IFDEF AHMINPRISE4} Stored IsVisibleStored {$ENDIF} default True;
    property Default: Boolean read FDefault write SetDefault default False;
    property Enabled: Boolean read FEnabled write SetEnabled {$IFDEF AHMINPRISE4}Stored IsEnabledStored{$ENDIF} default True;
    property RadioItem: Boolean read FRadioItem write SetRadioItem default False;
    property ShortCut: TShortCut read FShortCut write SetShortCut {$IFDEF AHMINPRISE4}Stored IsShortcutStored{$ENDIF} default 0;
    property OnClick: TNotifyEvent read FOnClick write FOnClick {$IFDEF AHMINPRISE4}Stored IsOnClickStored{$ENDIF};
    property OnSelect : TNotifyEvent read FOnSelect write FOnSelect;
    property ImageIndex : Integer read FImageIndex write SetImageIndex {$IFDEF AHMINPRISE4}stored IsImageIndexStored{$ENDIF} default -1 ;
    property CheckedIndex : Integer read FCheckedIndex write SetCheckedIndex stored True default -1 ;
    property DisabledImageIndex : Integer read FDisabledImageIndex write SetDisabledImageIndex stored True default -1 ;
  end;
  TAHMFindItemKind = (fkCommand, fkHandle, fkShortCut);
  TAHMOnHint = procedure(Sender:TObject; LongHint,Hint : String) of Object;
  TAHMSelectType = (selNormal,selRaised,selSunken);
  TAHMMenu = class(TPopupMenu)
  private
    FAutoPopup: Boolean;
    FHookClass : TAHMMenuHookClass;
    FSelectType : TAHMSelectType;
    FOnHint : TAHMOnHint;
    FItems: TAHMMenuItem;
    FCursor: TCursor;
    FNewStyles : Boolean;
    FWindowHandle: HWND;
    FMenuImage: string;
    FFont : TFont;
    FImages: TImageList;
    FImageChangeLink: TChangeLink;
    FSelectedFont : TFont;
    FSelectedColor : TColor;
    FDividerFont : TFont;
    FOnPopup: TNotifyEvent;
    FAlignment: TPopupAlignment;
    FAboutMenus : String;
    procedure SetSelectType(Value : TAHMSelectType);
    {$IFNDEF AHMINPRISE5} procedure DoPopup(Item: TObject); {$ENDIF}
    procedure SetNewStyles(Value : Boolean);
    procedure SetSelectedColor(Value : TColor);
    procedure SetMenuFont(Value : TFont);
    procedure SetSelectedFont(Value : TFont);
    procedure FontChange(Sender : TObject);
    procedure SetImages(Value: TImageList);
    procedure ImageListChange(Sender: TObject);
    procedure SetWindowHandle(Value: HWND);
    function UpdateImage: Boolean;
    procedure SetDividerFont(Value : TFont);
    procedure ReloadHook(Sender : TObject);
    procedure BeforeReloadHook(Sender : TObject);
  protected
    {$IFDEF AHMINPRISE5} procedure DoPopup(Item: TObject);  override; {$ENDIF}
    procedure MenuChanged(Sender: TObject;{$IFDEF AHMINPRISE4}Source : TMenuItem;{$ENDIF} Rebuild: Boolean); {$IFDEF AHMINPRISE4} override; {$ELSE}{$IFDEF AHMBUILDER} override; {$ELSE} virtual;{$ENDIF} {$ENDIF}
    Function GetWindowHandle : HWnd;
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
    {$IFNDEF AHMINPRISE3}
    procedure GetChildren(Proc: TGetChildProc); override;
    {$ELSE}
    procedure GetChildren(Proc: TGetChildProc; Root: TComponent); override;
    {$ENDIF}
    function GetHandle: HMENU; override;
    procedure SetChildOrder(Child: TComponent; Order: Integer); override;
    procedure WndProc(var Message: TMessage;var Handled : Boolean);
    procedure SetOwnerDrawAll; virtual;
    procedure SetMenu;
  public
    procedure Popup(X, Y: Integer); override;
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure Loaded; override;
    function DispatchCommand(ACommand: Word): Boolean;
    function DispatchPopup(AHandle: HMENU): Boolean;
    function FindItem(Value: Integer; Kind: TAHMFindItemKind): TAHMMenuItem;
    function GetHelpContext(Value: Integer; ByCommand: Boolean): THelpContext;
    function IsShortCut(var Message: TWMKey): Boolean; {$IFDEF AHMINPRISE4} override; {$ENDIF}
    property Handle: HMENU read GetHandle;
    property WindowHandle: HWND read GetWindowHandle write SetWindowHandle;
  published
    property AboutMenus : String read FAboutMenus write FAboutMenus;
    property AutoPopup: Boolean read FAutoPopup write FAutoPopup default True;
    property PopupAlignment: TPopupAlignment read FAlignment write FAlignment default paLeft;
    property Cursor: TCursor read FCursor write FCursor default crDefault;
    property SelectedFont : TFont read FSelectedFont write SetSelectedFont;
    property SelectedColor : TColor read FSelectedColor write SetSelectedColor;
    property NewStyles : Boolean read FNewStyles write SetNewStyles default true;
    property SelectType : TAHMSelectType read FSelectType write SetSelectType default selNormal;
    property MenuFont : TFont read FFont write SetMenuFont;
    property DividerFont : TFont read FDividerFont write SetDividerFont;
    property Images: TImageList read FImages write SetImages;
    property Items: TAHMMenuItem read FItems;
    property OnPopup: TNotifyEvent read FOnPopup write FOnPopup;
    property OnHint : TAHMOnHint read FOnHint write FOnHint;
  end;
  TAHMMainMenu = class(TAHMMenu)
  private
    FOle2Menu: HMENU;
    FAutoMerge: Boolean;
    procedure ItemChanged;
    procedure SetAutoMerge(Value: Boolean);
  protected
    function GetHandle: HMENU; override;
  public
    procedure MenuChanged(Sender: TObject;{$IFDEF AHMINPRISE4}Source : TMenuItem;{$ENDIF} Rebuild: Boolean); override;
    procedure Merge(Menu: TAHMMainMenu);
    procedure Unmerge(Menu: TAHMMainMenu);
    procedure PopulateOle2Menu(SharedMenu: HMenu; Groups: array of Integer;
      var Widths: array of Longint);
    procedure GetOle2AcceleratorTable(var AccelTable: HAccel;
      var AccelCount: Integer; Groups: array of Integer);
    procedure SetOle2MenuHandle(Handle: HMENU);
    procedure Loaded; override;
  published
    property AutoMerge: Boolean read FAutoMerge write SetAutoMerge default False;
  end;
  TAHMPopupMenu = class(TAHMMenu)
  private
    OSubMenu : TAHMSubMenu;
    FPopupDetails : TAHMSubMenu;
    function GetHelpContext: THelpContext;
    procedure SetHelpContext(Value: THelpContext);
    Procedure ChangeSubMenu(Sender : TObject);
  public
    constructor Create(AOwner: TComponent); override;
    procedure Loaded; override;
    destructor Destroy; override;
  published
    property PopupDetails : TAHMSubMenu read FPopupDetails write FPopupDetails;
    property HelpContext: THelpContext read GetHelpContext write SetHelpContext default 0;
  end;
  TAHMFormMenu = class(TAHMPopupMenu)
  private
  public
    constructor Create(AOwner: TComponent); override;
    procedure Loaded; override;
    Destructor Destroy; override;
  published

  end;
  TAHMApplicationMenu = class(TAHMPopupMenu)
  private
  public
    constructor Create(AOwner: TComponent); override;
    procedure Loaded; override;
    Destructor Destroy; override;
  published

  end;

implementation

uses  Forms,AHMMenuConst;
var CurrentMenu : TAHMMenu = nil;
    HKeyHook : Integer = 0;
    ActiveMenu : HMenu;
    AHMWorkTmp : TBitmap;
    AHMWorkInx : TAHMMenuItem;

Procedure DrawTransparentBitmap(xCanvas: TCanvas;bmp: TBitmap;xStart,yStart: Integer;cTransparentColor: LongInt);
var NewImage : TBitmap;
begin
  NewImage:=TBitmap.Create;
  NewImage.Width:=bmp.width;
  NewImage.Height:=bmp.Height;
  NewImage.Canvas.Copyrect(Rect(0,0,bmp.width,bmp.height),bmp.Canvas,Rect(0,0,bmp.width,bmp.height));
  with TImageList.CreateSize(bmp.Width,bmp.Height) do
  try
    Draw(xCanvas, xStart, yStart,AddMasked(NewImage,cTransparentcolor));
  finally
    Free;
  end;
  NewImage.Free;
end;

procedure Error(const S: string);
begin
  raise EAHMMenuError.Create(S);
end;

procedure IndexError;
begin
  Error(ahmmnumenuindexerror);
end;

var AHMCommandPool : TBits;

function UniqueCommand: Word;
begin
  Result := AHMCommandPool.OpenBit;
  AHMCommandPool[Result] := True;
end;

procedure IterateMenus(Func: Pointer; Menu1, Menu2: TAHMMenuItem);
var I , J: Integer;
    IIndex, JIndex: Byte;
    Menu1Size, Menu2Size: Integer;
    Done: Boolean;
function Iterate(var I: Integer; MenuItem: TAHMMenuItem; AFunc: Pointer): Boolean;
var Item : TAHMMenuItem;
begin
  if MenuItem = nil then Exit;
  Result := False;
  while not Result and (I < MenuItem.Count) do
  begin
    Item := MenuItem[I];
    if Item.GroupIndex > IIndex then Break;
    asm
      MOV     EAX,Item
      MOV     EDX,[EBP+8]
      PUSH    DWORD PTR [EDX]
      CALL    DWORD PTR AFunc
      ADD     ESP,4
      MOV     Result,AL
    end;
    Inc(I);
  end;
end;

begin
  I := 0;
  J := 0;
  Menu1Size := 0;
  Menu2Size := 0;
  if Menu1 <> nil then Menu1Size := Menu1.Count;
  if Menu2 <> nil then Menu2Size := Menu2.Count;
  Done := False;
  while not Done and ((I < Menu1Size) or (J < Menu2Size)) do
  begin
    IIndex := High(Byte);
    JIndex := High(Byte);
    if (I < Menu1Size) then IIndex := Menu1[I].GroupIndex;
    if (J < Menu2Size) then JIndex := Menu2[J].GroupIndex;
    if IIndex <= JIndex then Done := Iterate(I, Menu1, Func)
    else
    begin
      IIndex := JIndex;
      Done := Iterate(J, Menu2, Func);
    end;
    while (I < Menu1Size) and (Menu1[I].GroupIndex <= IIndex) do Inc(I);
    while (J < Menu2Size) and (Menu2[J].GroupIndex <= IIndex) do Inc(J);
  end;
end;

procedure TAHMMenu.ReloadHook(Sender : TObject);
begin
  if not(csdestroying in Componentstate) then
  if (self is TAHMMainMenu) then
  begin
    FItems.Fhandle:=0;
    Windows.SetMenu(TWincontrol(Owner).Handle,Handle);
 end else
 begin
   FItems.FHandle:=GetSystemMenu(GetWindowHandle,False);
   DestroyMenu(FItems.FHandle);
   FItems.FHandle:=0;
 end;
 SendMessage(FWindowHandle, CM_MENUCHANGED, 0, 0);
end;

procedure TAHMMenu.BeforeReloadHook;
Procedure ClearAll;
Var I : Integer;
procedure ClearCurrent(Cmenu : TAHMMenuItem);
Var I : Integer;
begin
  CMenu.FHandle:=0;
  For I:=0 to CMenu.Count-1 do ClearCurrent(CMenu.Items[I]);
end;
begin
  For I:=0 to Fitems.Count-1 do ClearCurrent(FItems[I]);
end;
begin
  if not(csdestroying in Componentstate) then
  begin
    if (self is TAHMMainMenu) then
    begin
      ClearAll;
      FWindowHandle:=TWincontrol(Owner).Handle;
    end else
    if (self is TAHMFormMenu) then  FWindowHandle:=TWincontrol(Owner).Handle;
  end;
end;

{$IFDEF AHMINPRISE4}
procedure TAHMMenuActionLink.AssignClient(AClient: TObject);
begin
  FClient := AClient as TAHMMenuItem;
end;

function TAHMMenuActionLink.IsCaptionLinked: Boolean;
begin
  Result := inherited IsCaptionLinked and
    (FClient.Caption = (Action as TCustomAction).Caption);
end;

function TAHMMenuActionLink.IsCheckedLinked: Boolean;
begin
  Result := inherited IsCheckedLinked and
    (FClient.Checked = (Action as TCustomAction).Checked);
end;

function TAHMMenuActionLink.IsEnabledLinked: Boolean;
begin
  Result := inherited IsEnabledLinked and
    (FClient.Enabled = (Action as TCustomAction).Enabled);
end;

function TAHMMenuActionLink.IsHelpContextLinked: Boolean;
begin
  Result := inherited IsHelpContextLinked and
    (FClient.HelpContext = (Action as TCustomAction).HelpContext);
end;

function TAHMMenuActionLink.IsHintLinked: Boolean;
begin
  Result := inherited IsHintLinked and
    (FClient.Hint = (Action as TCustomAction).Hint);
end;

function TAHMMenuActionLink.IsImageIndexLinked: Boolean;
begin
  Result := inherited IsImageIndexLinked and
    (FClient.ImageIndex = (Action as TCustomAction).ImageIndex);
end;

function TAHMMenuActionLink.IsShortCutLinked: Boolean;
begin
  Result := inherited IsShortCutLinked and
    (FClient.ShortCut = (Action as TCustomAction).ShortCut);
end;

function TAHMMenuActionLink.IsVisibleLinked: Boolean;
begin
  Result := inherited IsVisibleLinked and
    (FClient.Visible = (Action as TCustomAction).Visible);
end;

function TAHMMenuActionLink.IsOnExecuteLinked: Boolean;
begin
  Result := inherited IsOnExecuteLinked and
    (@FClient.OnClick = @Action.OnExecute);
end;

procedure TAHMMenuActionLink.SetCaption(const Value: string);
begin
  if IsCaptionLinked then FClient.Caption := Value;
end;

procedure TAHMMenuActionLink.SetChecked(Value: Boolean);
begin
  if IsCheckedLinked then FClient.Checked := Value;
end;

procedure TAHMMenuActionLink.SetEnabled(Value: Boolean);
begin
  if IsEnabledLinked then FClient.Enabled := Value;
end;

procedure TAHMMenuActionLink.SetHelpContext(Value: THelpContext);
begin
  if IsHelpContextLinked then FClient.HelpContext := Value;
end;

procedure TAHMMenuActionLink.SetHint(const Value: string);
begin
  if IsHintLinked then FClient.Hint := Value;
end;

procedure TAHMMenuActionLink.SetImageIndex(Value: Integer);
begin
  if IsImageIndexLinked then FClient.ImageIndex := Value;
end;

procedure TAHMMenuActionLink.SetShortCut(Value: TShortCut);
begin
  if IsShortCutLinked then FClient.ShortCut := Value;
end;

procedure TAHMMenuActionLink.SetVisible(Value: Boolean);
begin
  if IsVisibleLinked then FClient.Visible := Value;
end;

procedure TAHMMenuActionLink.SetOnExecute(Value: TNotifyEvent);
begin
  if IsOnExecuteLinked then FClient.OnClick := Value;
end;
{$ENDIF}

constructor TAHMBitmapItem.Create(AOwner : TComponent);
begin
  FTransparentColor:=clNone;
  FCaptionOnTop:=False;
  inherited Create;
  FBitmap := TBitmap.Create;
  FBitmap.OnChange:=BitmapChange;
end;

Destructor TAHMBitmapItem.Destroy;
begin
  FBitmap.OnChange:=nil;
  FBitmap.Free;
  inherited Destroy;
end;

procedure TAHMBitmapItem.SetBitmap(Value : TBitmap);
begin
  FBitmap.assign(Value);
end;

procedure TAHMBitmapItem.BitmapChange(Sender : TObject);
begin
  Changed;
end;

procedure TAHMBitmapItem.SetTransparentColor(Value : TColor);
begin
  FTransparentColor:=Value;
  Changed;
end;

procedure TAHMBitmapItem.SetCaptionOnTop(Value : Boolean);
begin
  FCaptionOnTop:=Value;
  Changed;
end;

Function TAHMBitmapItem.HasBitmap : Boolean;
begin
  result:=(FBitmap<>nil) and (Fbitmap.Width>0) and (FBitmap.Height>0)
end;


constructor TAHMSubMenu.Create(AOwner : TComponent;AHMMenu : TAHMMenuItem);
begin
  FBackgroundType := btTiled;
  FBarColor := clNavy;
  FBarWidth := 15;
  FBarEnabled :=False;
  FColor := clMenu;
  FTransparentColor:=clNone;
  FBarFontName:='Arial';
  FBarFontSize:=8;
  FBarFontColor:=clWindowText;
  inherited Create;
  FBarAsGradient := TAHMMenuGradient.Create(self);
  FOwnerMenu := AHMMenu;
  FParentComponent:=AOwner;
  FBackground := TBitmap.Create;
  FBarBackground:=TBitmap.Create;
  FBackground.OnChange:=SubMenuChange;
  FBarAsGradient.OnChange:=SubMenuChange;
  FBarBackground.OnChange:=SubMenuChange;
end;

procedure TAHMSubMenu.SetBarCaption(Value : String);
begin
  if (FBarCaption<>Value) then
  begin
    FBarCaption:=Value;
    if not(csLoading in FOwnerMenu.ComponentState) then SubMenuChange(Self);
  end;
end;

procedure TAHMSubMenu.SetBarColor(Value : TColor);
begin
  if (FBarColor<>Value) then
  begin
    FBarColor:=Value;
    if not(csLoading in FOwnerMenu.ComponentState) then  SubMenuChange(Self);
  end;
end;


procedure TAHMSubMenu.SetBackground(Value : TBitmap);
begin
  if FBackground<>Value then  FBackground.assign(Value);
end;

procedure TAHMSubMenu.SetBackgroundType(Value : TAHMBackgroundType);
begin
  if FBackgroundType<>Value then
  begin
    FBackgroundType:=Value;
    Changed;
  end;
end;

procedure TAHMSubMenu.SetEnabled(Value : Boolean);
begin
  FEnabled := Value;
  SubMenuChange(Self);
end;

procedure TAHMSubMenu.SetBarBackground(Value : TBitmap);
begin
  FBarBackground.Assign(Value);
  if not(csLoading in FOwnerMenu.ComponentState) then changed;
end;

procedure TAHMSubMenu.SetBarFontSize(Value : Byte);
begin
  if FBarFontSize<>Value then
  begin
    FBarFontSize:=Value;
    if not(csLoading in FOwnerMenu.ComponentState) then SubMenuChange(Self);
  end;
end;

procedure TAHMSubMenu.SetBarFontColor(Value :TColor);
begin
  if FBarFontColor<>Value then
  begin
    FBarFontColor:=Value;
    if not(csLoading in FOwnerMenu.ComponentState) then SubMenuChange(Self);
  end;
end;

procedure TAHMSubMenu.SetBarFontName(Value : String);
begin
  if FBarFontName<>Value then
  begin
    FBarFontName:=Value;
    if not(csLoading in FOwnerMenu.ComponentState) then SubMenuChange(Self);
  end;
end;

procedure TAHMSubMenu.SubMenuChange(Sender : TObject);
begin
  AHMWorkInx:=nil;
  if not(csLoading in FOwnerMenu.ComponentState) then Changed;
end;

procedure TAHMSubMenu.SetBarWidth(Value : TAHMBarWidth);
begin
  if (FBarWidth<>Value) then
  begin
    FBarWidth:=Value;
    if not(csLoading in FOwnerMenu.ComponentState) then Changed;
  end;
end;

procedure TAHMSubMenu.SetBarEnabled(Value : Boolean);
begin
  if FBarEnabled<>Value then
  begin
    FBarEnabled:=Value;
    if not(csLoading in FOwnerMenu.ComponentState) then Changed;
  end;
end;

procedure TAHMSubMenu.SetColor(Value : TColor);
begin
  if FColor<>Value then
  begin
    FColor:=Value;
    if not(csLoading in FOwnerMenu.ComponentState) then Changed;
  end;
end;

procedure TAHMSubMenu.SetTransparentColor(Value : TColor);
begin
  if FTransparentColor<>Value then
  begin
    FTransparentColor:=Value;
    if not(csLoading in FOwnerMenu.ComponentState) then Changed;
  end;
end;


destructor TAHMSubMenu.Destroy;
begin
  FBarBackground.OnChange:=nil;
  FBackground.OnChange:=nil;
  FBarAsGradient.OnChange:=nil;
  FBarBackground.Free;
  FBarAsGradient.Free;
  FBackground.Free;
  inherited Destroy;
end;

procedure TAHMSubMenu.SetBarAsGradient(Value : TAHMMenuGradient);
begin
  FBarAsGradient.Assign(Value);
end;

Constructor TAHMMenuGradient.Create(Owner : TAHMSubMenu);
begin
  inherited create;
  FOwner:=Owner;
  FActive:=False;
  FFadeToColor:=clBlack;
  FColorCount:=32;
end;

Procedure TAHMMenuGradient.Draw(const Cdc:HDC;iWidth,iHeight : Integer);
var
  BeginRGBValue  : array[0..2] of Byte;
  RGBDifference  : array[0..2] of Integer;
  ColorBand : TRect;
  I         : Integer;
  R,G,B     : Byte;
  WorkBmp   : TBitmap;
  fhs,fhe : Integer;
begin
  WorkBmp := TBitmap.Create;
  try
    workbmp.dormant;
    workbmp.Width  := iWidth;
    workbmp.Height := iHeight;
    workbmp.Canvas.pen.width:=1;
    workbmp.canvas.brush.color:=FOwner.BarColor;
    workbmp.canvas.pen.color:=FFadeToColor;
    workbmp.canvas.brush.style:=bssolid;
    workbmp.Canvas.FillRect(Rect(0,0,iwidth,iheight));
    BeginRGBValue[0]:=GetRValue(ColorToRGB(FOwner.BarColor));
    BeginRGBValue[1]:=GetGValue(ColorToRGB(FOwner.BarColor));
    BeginRGBValue[2]:=GetBValue(ColorToRGB(FOwner.BarColor));
    RGBDifference[0]:=GetRValue(ColorToRGB(FFadeToColor))-BeginRGBValue[0];
    RGBDifference[1]:=GetGValue(ColorToRGB(FFadeToColor))-BeginRGBValue[1];
    RGBDifference[2]:=GetBValue(ColorToRGB(FFadeToColor))-BeginRGBValue[2];
    if (FColorCount>1) then
    for I := 0 to FColorCount -1 do
    begin
      R  := BeginRGBValue[0] + round(MulDiv (I, RGBDifference[0],FColorCount-1));
      G  := BeginRGBValue[1] + round(MulDiv (I, RGBDifference[1],FColorCount-1));
      B  := BeginRGBValue[2] + round(MulDiv (I, RGBDifference[2],FColorCount-1));
      if r<1 then r:=1; if g<1 then g:=1; if b<1 then b:=1;
      Workbmp.Canvas.Pen.Color:=RGB (R, G, B);
      Workbmp.Canvas.Brush.color:=RGB (R, G, B);
      Workbmp.Canvas.Brush.style:=bssolid;
      FHe:=Round(iHeight/(FColorCount));
      FHs:=FHe*I;
      ColorBand.Top    := MulDiv (I    ,fhe,FColorCount);
      ColorBand.Bottom := MulDiv (I + 2,fhe,FColorCount);
      Patblt(Workbmp.Canvas.handle,0,fhs+Colorband.top,
           iwidth,fhs+Colorband.bottom-Colorband.top,PatCopy);
    end;
    BitBlt(Cdc,0,0,iwidth,iheight,Workbmp.canvas.handle,0,0,srcCopy);
  finally
    WorkBmp.Free;
  end;
end;

Procedure TAHMMenuGradient.SetActive(Value : Boolean);
begin
  FActive:=value;
  changed;
end;

Procedure TAHMMenuGradient.SetFadeToColor(Value : TColor);
begin
  FFadeToColor:=value;
  changed;
end;

Procedure TAHMMenuGradient.SetColorCount(Value : Byte);
begin
  FColorCount:=value;
  changed;
end;


constructor TAHMMenuItem.Create(AOwner: TComponent);
begin
  FDestroy:=False;
  FItemHeight:=0;
  FItemWidth:=0;
  FDisabledImageIndex:=-1;
  FImageIndex:=-1;
  FCheckedIndex:=-1;
  FDivider := False;
  FSystemItem:=sicNone;
  FHelpContext:=0;
  inherited Create(AOwner);
  FAsBitmapItem:=TAHMBitmapItem.Create(Self);
  FAsBitmapItem.OnChange:=SubMenuChange;
  FSubMenuDetails:=TAHMSubMenu.Create(self,self);
  FSubMenuDetails.OnChange:=SubMenuChange;
  FEnabled := True;
  FVisible :=True;
  FCommand := UniqueCommand;
end;

procedure TAHMMenuItem.Loaded;
begin
  inherited Loaded;
  {$IFDEF AHMINPRISE4}
  if Action <> nil then ActionChange(Action, True);
  {$ENDIF}
end;

Function TAHMMenuItem.GetAHMMenu : TAHMMenu;
var CurrentItem : TComponent;
begin
  CurrentItem:=self;//GetParentComponent;
  while not(CurrentItem is TAHMMenu) and not(CurrentItem=nil) do
     CurrentItem:=(CurrentItem as TAHMMenuItem).GetParentComponent;
  result:=(CurrentItem as TAHMMenu);
end;

Function TAHMMenuItem.HasImage : Boolean;
begin
  result:=Assigned(GetAHMMenu.Images) and ((ImageIndex>-1) or (CheckedIndex>-1) or
    (DisabledImageIndex>-1));
end;

Function TAHMMenuItem.ImageInMenuNoRoot : Boolean;
var FoundImage : Boolean;
    I : Integer;
begin
  FoundImage:=False;
  if Assigned(GetAHMMenu.Images) then
  if not(ValidateType) then
  For I:=0 to Parent.Count-1 do
      FoundImage := FoundImage or Parent.Items[I].HasImage;
  result:=FoundImage;
end;

procedure TAHMMenuItem.SystemClick(Sender : TObject);
begin
  if (Sender is TAHMMenuItem) then
  SendMessage(GetAHMMenu.Windowhandle,WM_SYSCOMMAND,TAHMMenuItem(Sender).FCommand,-1);
end;

Function TAHMMenuItem.GetSubSize : TPoint;
var I : Integer;
begin
  result.x:=0;
  result.y:=0;
  for I:=0 to Count-1 do
  if Items[I].Visible then
  begin
    Inc(Result.y,Items[I].FItemHeight);
    if result.x<Items[I].FItemWidth+20 then result.x:=Items[I].FItemWidth+20;
  end;
end;

destructor TAHMMenuItem.Destroy;
begin
  FDestroy:=True;
//  MenuChanged(True);
  if FParent <> nil then
  begin
    FParent.Remove(Self);
    FParent := nil;
  end;
  if FSubMenuDetails<>nil then
  begin
    FSubMenuDetails.OnChange:=nil;
    FSubMenuDetails.Free;
  end;
  FAsBitmapItem.OnChange:=nil;
  FAsBitmapItem.Free;
  if FHandle <> 0 then
  begin
    MergeWith(nil);
    if IsMenu(FHandle) then (DestroyMenu(FHandle));
    ClearHandles;
  end;
  while Count > 0 do Items[0].Free;
  if FItems<>nil then FItems.Free;
  {$IFDEF AHMINPRISE4}
  if FActionLink<>nil then FActionLink.Free;
  FActionLink := nil;
  {$ENDIF}
  if FCommand <> 0 then AHMCommandPool[FCommand] := False;
  inherited Destroy;
end;

procedure TAHMMenuItem.SubMenuChange(Sender : TObject);
begin
  MenuChanged(not((csLoading in Componentstate) or (csDestroying in Componentstate)));
end;

{$IFDEF AHMINPRISE4}
function TAHMMenuItem.GetAction: TBasicAction;
begin
  if FActionLink <> nil then
    Result := FActionLink.Action else
    Result := nil;
end;

function TAHMMenuItem.GetAHMActionLinkClass: TAHMMenuActionLinkClass;
begin
  Result := TAHMMenuActionLink;
end;

procedure TAHMMenuItem.InitiateAction;
begin
  if FActionLink <> nil then FActionLink.Update;
end;

procedure TAHMMenuItem.SetAction(Value: TBasicAction);
begin
  if Value = nil then
  begin
    FActionLink.Free;
    FActionLink := nil;
  end
  else
  begin
    if FActionLink = nil then
      FActionLink := GetAHMActionLinkClass.Create(Self);
    FActionLink.Action := Value;
    FActionLink.OnChange := DoActionChange;
    ActionChange(Value, csLoading in Value.ComponentState);
    Value.FreeNotification(Self);
  end;
end;

procedure TAHMMenuItem.InitiateActions;
var I: Integer;
begin
  for I := 0 to Count - 1 do Items[I].InitiateAction;
end;

procedure TAHMMenuItem.ActionChange(Sender: TObject; CheckDefaults: Boolean);
begin
  if Action is TCustomAction then
    with TCustomAction(Sender) do
    begin
      if not CheckDefaults or (Self.Caption = '') then
        Self.Caption := Caption;
      if not CheckDefaults or (Self.Checked = False) then
        Self.Checked := Checked;
      if not CheckDefaults or (Self.Enabled = True) then
        Self.Enabled := Enabled;
      if not CheckDefaults or (Self.HelpContext = 0) then
        Self.HelpContext := HelpContext;
      if not CheckDefaults or (Self.Hint = '') then
        Self.Hint := Hint;
      if not CheckDefaults or (Self.ImageIndex = -1) then
        Self.ImageIndex := ImageIndex;
      if not CheckDefaults or (Self.ShortCut = scNone) then
        Self.ShortCut := ShortCut;
      if not CheckDefaults or (Self.Visible = True) then
        Self.Visible := Visible;
      if not CheckDefaults or not Assigned(Self.OnClick) then
        Self.OnClick := OnExecute;
    end;
end;

procedure TAHMMenuItem.DoActionChange(Sender: TObject);
begin
  if Sender = Action then ActionChange(Sender, False);
end;

function TAHMMenuItem.IsCaptionStored: Boolean;
begin
  Result := (ActionLink = nil) or not FActionLink.IsCaptionLinked;
end;

function TAHMMenuItem.IsCheckedStored: Boolean;
begin
  Result := (ActionLink = nil) or not FActionLink.IsCheckedLinked;
end;

function TAHMMenuItem.IsEnabledStored: Boolean;
begin
  Result := (ActionLink = nil) or not FActionLink.IsEnabledLinked;
end;

function TAHMMenuItem.IsHintStored: Boolean;
begin
  Result := (ActionLink = nil) or not FActionLink.IsHintLinked;
end;

function TAHMMenuItem.IsHelpContextStored: Boolean;
begin
  Result := (ActionLink = nil) or not FActionLink.IsHelpContextLinked;
end;

function TAHMMenuItem.IsImageIndexStored: Boolean;
begin
  Result := (ActionLink = nil) or not FActionLink.IsImageIndexLinked;
end;

function TAHMMenuItem.IsShortCutStored: Boolean;
begin
  Result := (ActionLink = nil) or not FActionLink.IsShortCutLinked;
end;

function TAHMMenuItem.IsVisibleStored: Boolean;
begin
  Result := (ActionLink = nil) or not FActionLink.IsVisibleLinked;
end;

function TAHMMenuItem.IsOnClickStored: Boolean;
begin
  Result := (ActionLink = nil) or not FActionLink.IsOnExecuteLinked;
end;

procedure TAHMMenuItem.AssignTo(Dest: TPersistent);
begin
  if Dest is TCustomAction then
    with TCustomAction(Dest) do
    begin
      Enabled := Self.Enabled;
      HelpContext := Self.HelpContext;
      Hint := Self.Hint;
      ImageIndex := Self.ImageIndex;
      Caption := Self.Caption;
      Visible := Self.Visible;
      OnExecute := Self.OnClick;
    end
  else inherited AssignTo(Dest);
end;

procedure TAHMMenuItem.Notification(AComponent: TComponent;
  Operation: TOperation);
begin
  inherited Notification(AComponent, Operation);
  if (Operation = opRemove) and (AComponent = Action) then Action := nil;
end;


{$ENDIF}

procedure TAHMMenuItem.SetAsBitmapItem(Value : TAHMBitmapItem);
begin
  FAsBitmapItem.Assign(Value);
end;

procedure TAHMMenuItem.ClearHandles;
procedure FixClear(Item: TAHMMenuItem);
var I : Integer;
begin
  with Item do
  begin
    FHandle := 0;
    for I := 0 to GetCount - 1 do FixClear(FItems[I]);
  end;
end;
begin
  FixClear(Self);
end;

const
  Checks: array[Boolean] of LongInt = (MF_UNCHECKED, MF_CHECKED);
  Enables: array[Boolean] of LongInt = (MF_DISABLED or MF_GRAYED, MF_ENABLED);
  Breaks: array[TAHMMenuBreak] of Longint = (0, MF_MENUBREAK, MF_MENUBARBREAK);
  Separators: array[Boolean] of LongInt = (MF_STRING, MF_SEPARATOR);

procedure TAHMMenuItem.AppendTo(Menu: HMENU);
const
  IBreaks: array[TAHMMenuBreak] of Longint = (MFT_STRING, MFT_MENUBREAK, MFT_MENUBARBREAK);
  IChecks: array[Boolean] of Longint = (MFS_UNCHECKED, MFS_CHECKED);
  IDefaults: array[Boolean] of Longint = (0, MFS_DEFAULT);
  IEnables: array[Boolean] of Longint = (MFS_DISABLED or MFS_GRAYED, MFS_ENABLED);
  IRadios: array[Boolean] of Longint = (MFT_STRING, MFT_RADIOCHECK);
  ISeparators: array[Boolean] of Longint = (MFT_STRING, MFT_SEPARATOR);
  IBitmap: array[Boolean] of LongInt = (0,MFT_BITMAP);
var
  MenuItemInfo: TMenuItemInfo;
  Caption: string;
  NewFlags: Integer;
begin
  if Visible then
  begin
    Caption := FCaption;
    if GetCount > 0 then MenuItemInfo.hSubMenu := GetHandle else
    if (FShortCut <> scNone) and ((Parent = nil) or
      (Parent.Parent <> nil) or not (Parent.Owner is TAHMMainMenu)) then
      Caption := Caption + #9 + ShortCutToText(FShortCut);
    if Lo(GetVersion) >= 4 then
    begin
      {$IFDEF AHMINPRISE4}
      MenuItemInfo.cbSize := 44;
      {$ELSE}
      MenuItemInfo.cbSize := SizeOf(TMenuItemInfo);// Fixed bug AHM 25/07/98 whatever it is it works now :)
      {$ENDIF}
      MenuItemInfo.fMask := MIIM_CHECKMARKS or MIIM_DATA or MIIM_ID or
        MIIM_STATE or MIIM_SUBMENU or MIIM_TYPE;
      MenuItemInfo.fType := IRadios[FRadioItem] or IBreaks[FBreak] or
        IBitmap[(FAsBitmapItem.Bitmap.Width>0) and (FAsBitmapItem.Bitmap.Height>0)] or
        ISeparators[FDivider] or Integer(GetAHMMenu.FNewStyles) * MFT_OWNERDRAW;
      MenuItemInfo.fState := IChecks[FChecked] or IEnables[FEnabled]
        or IDefaults[FDefault];
      MenuItemInfo.wID := FCommand;
      MenuItemInfo.hbmpChecked := 0;
      MenuItemInfo.hbmpUnchecked := 0;
      if not((FAsBitmapItem.Bitmap.Width>0) and (FAsBitmapItem.Bitmap.Height>0)) then
         MenuItemInfo.dwTypeData := PChar(Caption)
         else MenuItemInfo.dwTypeData := PChar(LoWord(FasBitmapItem.Bitmap.handle));
     if GetCount > 0 then MenuITemInfo.hSubMenu := GetHandle else  MenuItemInfo.hSubMenu := 0;
      InsertMenuItem(Menu,DWord(-1), True, MenuItemInfo);
    end else
    begin
      NewFlags := Breaks[FBreak] or Checks[FChecked] or Enables[FEnabled] or Separators[FDivider] or MF_BYPOSITION;
      if GetCount > 0 then InsertMenu(Menu,DWord(-1),Integer(GetAHMMenu.NewStyles) *MF_OWNERDRAW or MF_POPUP or NewFlags,GetHandle,PChar(FCaption))
                      else InsertMenu(Menu,DWord(-1),Integer(GetAHMMenu.NewStyles) *MF_OWNERDRAW or  NewFlags, Command, PChar(Caption));
    end;
  end;
end;

procedure TAHMMenuItem.PopulateMenu;
function AddIn(MenuItem: TAHMMenuItem): Boolean;
begin
  MenuItem.AppendTo(FHandle);
  Result := False;
end;
begin
  IterateMenus(@AddIn, FMerged, Self);
end;

procedure TAHMMenuItem.ReadShortCutText(Reader: TReader);
begin
  ShortCut := TextToShortCut(Reader.ReadString);
end;

procedure TAHMMenuItem.MergeWith(Menu: TAHMMenuItem);
begin
  if FMerged <> Menu then
  begin
    if FMerged <> nil then FMerged.FMergedWith := nil;
    FMerged := Menu;
    if FMerged <> nil then FMerged.FMergedWith := Self;
    RebuildHandle;
  end;
end;

procedure TAHMMenuItem.RebuildHandle;
begin
  if FMergedWith <> nil then FMergedWith.RebuildHandle else
  begin
    while GetMenuItemCount(Handle) > 0 do RemoveMenu(Handle, 0, MF_BYPOSITION);
    PopulateMenu;
    MenuChanged(False);
  end;
end;

procedure TAHMMenuItem.VerifyGroupIndex(Position: Integer; Value: Byte);
var I : Integer;
begin
  for I := 0 to GetCount - 1 do
  if I < Position then
  begin
    if Items[I].GroupIndex > Value then
    {$IFNDEF AHMINPRISE3}Error(LoadStr(ahmmnugroupindextoolow)){$ELSE}Error(ahmmnugroupindextoolow){$ENDIF}
  end else if Items[I].GroupIndex < Value then Items[I].GroupIndex := Value;
end;

procedure TAHMMenuItem.WriteShortCutText(Writer: TWriter);
begin
  {Writer.WriteString(ShortCutToText(ShortCut));}
end;

function TAHMMenuItem.GetHandle: HMENU;
begin
  if FHandle = 0 then
  begin
    if Owner is TAHMPopupMenu then FHandle := CreatePopupMenu else
    if (Owner is TAHMFormMenu)
      and (GetAHMMenu.Owner is TWinControl) then FHandle := GetSystemMenu(TWincontrol(GetAHMMenu.Owner).Handle,False)
                              else FHandle := CreateMenu;
    if FHandle = 0 then raise
    EAHMMenuError.Create(ahmmnuoutofresources);
    PopulateMenu;
  end;
  Result := FHandle;
end;

procedure TAHMMenuItem.SetSystemItem(Value : TAHMSystemItem);
begin
  if FSystemItem<>Value then
  begin
    FSystemItem:=Value;
    if FSystemItem<>sicNone then
    begin
      case FSystemItem of
        sicRestore  : FCommand := SC_RESTORE  AND 65520;
        sicMaximize : FCommand := SC_MAXIMIZE AND 65520;
        sicMinimize : FCommand := SC_MINIMIZE AND 65520;
        sicClose    : FCommand := SC_CLOSE    AND 65520;
        sicSize     : FCommand := SC_SIZE     AND 65520;
        sicMove     : FCommand := SC_MOVE     AND 65520;
        sicContextHelp : FCommand := SC_CONTEXTHELP AND 65520;
        sicTaskList : FCommand := SC_TASKLIST AND 65520;
        sicMonitorPower : FCommand := SC_MONITORPOWER AND 65520;
     end;
      OnClick:=SystemClick;
    end else
    begin
      FCommand:=UniqueCommand;
      OnCLick:=nil;
    end;
    Menuchanged(true);
  end;
end;

procedure TAHMMenuItem.DefineProperties(Filer: TFiler);
begin
  inherited DefineProperties(Filer);
  Filer.DefineProperty('ShortCutText', ReadShortCutText, WriteShortCutText, False);
end;

function TAHMMenuItem.HasParent: Boolean;
begin
  Result := True;
end;

procedure TAHMMenuItem.SetBreak(Value: TAHMMenuBreak);
begin
  if FBreak <> Value then
  begin
   if GetAHMMenu.NewStyles then FBreak := mbNone else FBreak := Value;
    MenuChanged(not((csLoading in Componentstate) or (csDestroying in Componentstate)));
  end;
end;

procedure TAHMMenuItem.SetImageIndex(Value : Integer);
begin
  if (value>-2) then
  begin
    FImageIndex:=Value;
    MenuChanged(not((csLoading in Componentstate) or (csDestroying in Componentstate)));
  end;
end;

procedure TAHMMenuItem.SetVisible(Value: Boolean);
begin
  if Value <> FVisible then
  begin
    FVisible := Value;
    MenuChanged(True);
  end;
end;


procedure TAHMMenuItem.SetCheckedIndex(Value : Integer);
begin
  if (value>-2) then
  begin
    FCheckedIndex:=Value;
    MenuChanged(not((csLoading in Componentstate) or (csDestroying in Componentstate)));
  end;
end;

procedure TAHMMenuItem.SetDisabledImageIndex(Value : Integer);
begin
  if value>-2 then
  begin
    FDisabledImageIndex:=Value;
    MenuChanged(not((csLoading in Componentstate) or (csDestroying in Componentstate)));
  end;
end;

procedure TAHMMenuItem.SetCaption(const Value: string);
begin
  if FCaption <> Value then
  begin
    FCaption := Value;
    MenuChanged(not((csLoading in Componentstate) or (csDestroying in Componentstate)));
  end;
end;

procedure TAHMMenuItem.TurnSiblingsOff;
var
  I: Integer;
  Item: TAHMMenuItem;
begin
  if FParent <> nil then
    for I := 0 to FParent.Count - 1 do
    begin
      Item := FParent[I];
      if (Item <> Self) and Item.FRadioItem and (Item.GroupIndex = GroupIndex) then
        Item.SetChecked(False);
    end;
end;

procedure TAHMMenuItem.SetChecked(Value: Boolean);

begin
  if FChecked <> Value then
  begin
    FChecked := Value;
    if FParent <> nil then CheckMenuItem(FParent.FHandle, FCommand, MF_BYCOMMAND or Checks[Value]);
    if Value and FRadioItem then TurnSiblingsOff;
  end;
end;

procedure TAHMMenuItem.SetEnabled(Value: Boolean);
begin
  if FEnabled <> Value then
  begin
    FEnabled := Value;
    if ((Win32Platform = VER_PLATFORM_WIN32_NT) and (Count <> 0)) or
      ((Parent <> nil) and Assigned(Parent.FMergedWith)) then MenuChanged(True)
    else
    begin
      if FParent <> nil then
       EnableMenuItem(FParent.FHandle, FCommand, MF_BYCOMMAND or Enables[Value]);
      MenuChanged(False);
    end;
  end;
end;

function TAHMMenuItem.GetCount: Integer;
begin
  if FItems = nil then Result := 0 else Result := FItems.Count;
end;

function TAHMMenuItem.GetItem(Index: Integer): TAHMMenuItem;
begin
  if FItems = nil then IndexError;
  Result := FItems[Index];
end;

procedure TAHMMenuItem.SeTShortCut(Value: TShortCut);
begin
  FShortCut := Value;
  MenuChanged(not((csLoading in Componentstate) or (csDestroying in Componentstate)));
end;

procedure TAHMMenuItem.SetDivider(Value : Boolean);
begin
  FDivider:=Value;
  MenuChanged(not((csLoading in Componentstate) or (csDestroying in Componentstate)));
end;

function TAHMMenuItem.GetMenuIndex: Integer;
begin
  Result := -1;
  if FParent <> nil then Result := FParent.IndexOf(Self);
end;

procedure TAHMMenuItem.SetMenuIndex(Value: Integer);
var
  Parent: TAHMMenuItem;
  Count: Integer;
begin
  if FParent <> nil then
  begin
    Count := FParent.Count;
    if Value < 0 then Value := 0;
    if Value >= Count then Value := Count - 1;
    if Value <> MenuIndex then
    begin
      Parent := FParent;
      Parent.Remove(Self);
      Parent.Insert(Value, Self);
    end;
  end;
end;

{$IFNDEF AHMINPRISE3}
procedure TAHMMenuItem.GetChildren(Proc: TGetChildProc);
{$ELSE}
procedure TAHMMenuItem.GetChildren(Proc: TGetChildProc; Root: TComponent);
{$ENDIF}
var I: Integer;
begin
  for I := 0 to Count - 1 do Proc(Items[I]);
end;

procedure TAHMMenuItem.SetChildOrder(Child: TComponent; Order: Integer);
begin
  (Child as TAHMMenuItem).MenuIndex := Order;
end;

procedure TAHMMenuItem.SetDefault(Value: Boolean);
var I: Integer;
begin
  if FDefault <> Value then
  begin
    if Value and (FParent <> nil) then
    for I := 0 to FParent.Count - 1 do
    if FParent[I].Default then FParent[I].FDefault := False;
    FDefault := Value;
    MenuChanged(not((csLoading in Componentstate) or (csDestroying in Componentstate)));
  end;
end;

procedure TAHMMenuItem.Insert(Index: Integer; Item: TAHMMenuItem);
begin
  if Item.FParent <> nil then raise EAHMMenuError.Create(ahmmnumenureinserted);
  if FItems = nil then FItems := TList.Create;
  if (Index - 1 >= 0) and (Index - 1 < FItems.Count) then
    if Item.GroupIndex < TAHMMenuItem(FItems[Index - 1]).GroupIndex then
      Item.GroupIndex := TAHMMenuItem(FItems[Index - 1]).GroupIndex;
  VerifyGroupIndex(Index, Item.GroupIndex);
  FItems.Insert(Index, Item);
  Item.FParent := Self;
  Item.FOnChange := SubItemChanged;
  if FHandle <> 0 then RebuildHandle;
  MenuChanged(Count = 1);
end;

procedure TAHMMenuItem.Delete(Index: Integer);
var
  Cur: TAHMMenuItem;
begin
  if (Index < 0) or (FItems = nil) or (Index >= GetCount) then IndexError;
  Cur := FItems[Index];
  FItems.Delete(Index);
  Cur.FParent := nil;
  Cur.FOnChange := nil;
  if FHandle <> 0 then RebuildHandle;
  MenuChanged(Count = 0);
end;

procedure TAHMMenuItem.Click;
begin
  {$IFNDEF AHMINPRISE4}
  if FEnabled and Assigned(FOnClick) then FOnClick(Self);
  {$ELSE}
  if FEnabled then
  begin
    if Assigned(FOnClick) and (Action <> nil) and (@FOnClick <> @Action.OnExecute) then
      FOnClick(Self)
    else if not (csDesigning in ComponentState) and (ActionLink <> nil) then
      FActionLink.Execute
    else if Assigned(FOnClick) then
      FOnClick(Self);
  end;
  {$ENDIF}
  if (csDesigning in Componentstate) and (GetAHMMenu.Owner is TCustomForm) and (GetCount=0) then
  TDefaultEditor(GetComponentEditor(self,{$IFDEF AHMINPRISE4}IFormDesigner{$ELSE}TFormDesigner{$ENDIF}(TCustomForm(GetAHMMenu.Owner).Designer))).Edit;
end;

function TAHMMenuItem.IndexOf(Item: TAHMMenuItem): Integer;
begin
  Result := -1;
  if FItems <> nil then Result := FItems.IndexOf(Item);
end;

procedure TAHMMenuItem.Add(Item: TAHMMenuItem);
begin
  Insert(GetCount, Item);
  MenuChanged(not((csLoading in Componentstate) or (csDestroying in Componentstate)));
  if (not((csLoading in Componentstate) or (csDestroying in Componentstate))) then FSubMenuDetails.SubMenuChange(Self);
end;

procedure TAHMMenuItem.Remove(Item: TAHMMenuItem);
var
  I: Integer;
begin
  I := IndexOf(Item);
  if I = -1 then raise EAHMMenuError.Create(ahmmnumenunotfound);
  Delete(I);
  MenuChanged(not((csLoading in Componentstate) or (csDestroying in Componentstate)));
//  if not(Item.FDestroy) then FSubMenuDetails.SubMenuChange(Self);
end;

procedure TAHMMenuItem.MenuChanged(Rebuild: Boolean);
{$IFDEF AHMINPRISE4}
var
  Source: TMenuItem;
begin
  if (Parent = nil) and (Owner is TMenu) then
    Source := nil else
    Source := Self;
  if Assigned(FOnChange) then FOnChange(Self, Source, Rebuild);
{$ELSE}
begin
  if Assigned(FOnChange) then FOnChange(Self, Rebuild);
{$ENDIF}

end;

procedure TAHMMenuItem.SubItemChanged(Sender: TObject;{$IFDEF AHMINPRISE4}Source : TMenuItem;{$ENDIF} Rebuild: Boolean);
begin
  if Rebuild and ((FHandle <> 0) or Assigned(FMergedWith)) then RebuildHandle;
  if Parent <> nil then Parent.SubItemChanged(Self,{$IFDEF AHMINPRISE4}Source,{$ENDIF} False)
  else if Owner is TAHMMainMenu then TAHMMainMenu(Owner).ItemChanged;
end;

function TAHMMenuItem.GetParentComponent: TComponent;
begin
  if (FParent= nil) then Result :=nil else
  begin
    if (FParent.FMenu <> nil) then Result := FParent.FMenu else result:=FParent;
  end;
end;

procedure TAHMMenuItem.SetParentComponent(Value: TComponent);
begin
  if FParent <> nil then FParent.Remove(Self);
  if Value <> nil then
  if Value is TAHMMenu then TAHMMenu(Value).Items.Add(Self) else
  if Value is TAHMMenuItem then TAHMMenuItem(Value).Add(Self);
end;

procedure TAHMMenuItem.SetRadioItem(Value: Boolean);
begin
  if FRadioItem <> Value then
  begin
    FRadioItem := Value;
    if FChecked and FRadioItem then TurnSiblingsOff;
    MenuChanged(not((csLoading in Componentstate) or (csDestroying in Componentstate)));
  end;
end;

Function TAHMMenuItem.ValidateType : Boolean;
begin
  result:=(GetParentComponent is TAHMMainMenu);
end;
Procedure AHMDrawDisabledBitmap(Canvas: TCanvas; x, y: Integer; bmp: TBitmap);
var MonoBmp: TBitmap;
begin
  MonoBmp := TBitmap.Create;
  try
    MonoBmp.assign(bmp);
    MonoBmp.Canvas.Brush.Color := clBlack;
    MonoBmp.Monochrome := True;
    Canvas.FillRect(Rect(0,0,Monobmp.Width,MonoBmp.Height));
    Canvas.Brush.Color := clBtnHighlight;
    SetTextColor(Canvas.Handle, clBlack);
    SetBkColor(Canvas.Handle, clWhite);
    BitBlt(Canvas.Handle,x+1,y+1,bmp.Width,bmp.Height,MonoBmp.Canvas.Handle,0,0,$00E20746);
    Canvas.Brush.Color := clBtnShadow;
    SetTextColor(Canvas.Handle, clBlack);
    SetBkColor(Canvas.Handle, clWhite);
    BitBlt(Canvas.Handle,x,y,bmp.Width,bmp.Height,MonoBmp.Canvas.Handle,0,0,$00E20746);
  finally
    MonoBmp.Free;
  end;
end;


procedure TAHMMenuItem.DrawMenuItem(var ADrawItem : TWMDrawItem);
var
  FTempBmp : TBitmap;
  DividerRect,TmpRect,TxtRect,GlyRect,BarRect : TRect;
  DSMode : Integer;
  ImgTopLeft : TPoint;
  UseImageIndex : Integer;
procedure DoBar(BarHDC : Integer;rcItems : TRect);
var ax,ay,bx,by : Integer;
    LF : TLogFont;
    Metrics: TTextMetric;
procedure DrawFont(Onto : TBitmap);
begin
  with Onto do
  begin
    FillChar(LF,sizeof(TLogFont),0);
    LF.lfheight := -MulDiv(Parent.SubMenuDetails.BarFontSize, GetDeviceCaps(BarHDC, LOGPIXELSY), 72);;
    LF.lfEscapement := 900;
    LF.lfOrientation := 900;
    LF.lfWeight := FW_Bold;
    StrPCopy(LF.lfFaceName,Parent.SubMenuDetails.BarFontName);
    LF.lfCharSet:=GetAHMMenu.MenuFont.CharSet;
    Canvas.Font.Handle:=CreateFontIndirect(LF);
    GetTextMetrics(Canvas.Handle, Metrics);
    if (Metrics.tmPitchandFamily and TMPF_TRUETYPE) = 0 then
    begin
      StrPCopy(LF.lfFaceName,'Arial');
      LF.lfCharSet:=GetAHMMenu.MenuFont.CharSet;
      Canvas.Font.Handle:=CreateFontIndirect(LF);
    end;
    Canvas.Font.Color:=Parent.SubMenuDetails.BarFontColor;
    SetBkMode(Canvas.Handle,1);
    Canvas.TextOut(0,Parent.GetSubSize.Y-2,Parent.SubMenuDetails.BarCaption);
  end;
end;
begin
    if (Parent.SubMenuDetails.Enabled) and (Parent.SubMenuDetails.BarEnabled) then
    try
      If AHMWorkInx=Parent then
      begin
        Bitblt(BarHDC,BarRect.Left,BarRect.Top,Parent.SubMenuDetails.BarWidth,BarRect.Bottom-BarRect.Top,
                      AHMWorkTmp.Canvas.Handle,BarRect.Left,BarRect.Top,SrcCopy);
      end else
      with AHMWorkTmp do
      begin
        AHMWorkInx:=Parent;
        Width  := Parent.SubMenuDetails.BarWidth;
        Height := Parent.GetSubSize.Y;
        SetBkColor(Canvas.Handle,Parent.SubMenuDetails.BarColor);
        if (Parent.SubMenuDetails.BarBackground.Width>0) and
           (Parent.SubMenuDetails.BarBackground.Height>0) then
        begin
          SetBkMode(Canvas.Handle,1);
          bx:=(Parent.SubMenuDetails.BarWidth div Parent.SubMenuDetails.BarBackground.Width);
          by:=(Parent.GetSubSize.Y div Parent.SubMenuDetails.BarBackground.Height);
          For ay:=0 to by do For ax:=0 to bx do
            Bitblt(Canvas.Handle,(ax*Parent.SubMenuDetails.BarBackground.Width),
                  (ay*Parent.SubMenuDetails.BarBackground.Height),
                   Parent.SubMenuDetails.BarBackground.Width,
                   Parent.SubMenuDetails.BarBackground.Height,
                   Parent.SubMenuDetails.BarBackground.Canvas.Handle,0,0,SrcCopy);
        end else
        begin
          if Parent.SubMenuDetails.BarAsGradient.Active then
          Parent.SubMenuDetails.BarAsGradient.Draw(Canvas.Handle,Width,Height) else
          begin
            Canvas.Brush.Color:=Parent.SubMenuDetails.BarColor;
            Canvas.FillRect(Rect(0,0,Width,Height));
          end;
        end;
        DrawFont(AHMWorkTmp);
        Bitblt(BarHDC,BarRect.Left,BarRect.Top,Parent.SubMenuDetails.BarWidth,BarRect.Bottom-BarRect.Top,
               Canvas.Handle,BarRect.Left,BarRect.Top,SrcCopy);
      end;
  except
    raise Exception.Create('Error drawing Menus');
  end;
end;
procedure DrawSub(Canvas :TCanvas;CanvasS,CanvasE : TPoint);
var wx,wy,ax,ay : Integer;
    Submeasures : TPoint;
Function InItem : Boolean;
begin
  result :=((ax*Parent.SubMenuDetails.FBackground.Width+Parent.SubMenuDetails.FBackground.Width)>CanvasS.X) and
           (ax*Parent.SubMenuDetails.FBackground.Width<CanvasE.X) and
          ((ay*Parent.SubMenuDetails.FBackground.Height+Parent.SubMenuDetails.FBackground.Height)>CanvasS.Y) and
           (ay*Parent.SubMenuDetails.FBackground.Height<CanvasE.Y);
end;
begin
  Submeasures := Parent.GetSubSize;
  Canvas.Brush.Color:=Parent.SubMenuDetails.Color;
  Canvas.FillRect(Rect( 0, 0, SubMeasures.X, Submeasures.Y));
  if (Parent.SubMenuDetails.Background.Width>0) and (Parent.SubMenuDetails.Background.Height>0) then
  if Parent.SubMenuDetails.BackgroundType=btTiled then
  begin
     wx:=Submeasures.X div Parent.SubMenuDetails.Background.Width;
     wy:=Submeasures.Y div Parent.SubMenuDetails.Background.Height;
     if Parent.SubMenuDetails.TransparentColor=clNone then
     begin
       For ax:=0 to wx do For ay:=0 to wy do
       if InItem then
       Bitblt(Canvas.Handle,ax*Parent.SubMenuDetails.FBackground.Width,
                            ay*Parent.SubMenuDetails.FBackground.Height,
                               Parent.SubMenuDetails.FBackground.Width,
                               Parent.SubMenuDetails.FBackground.Height,
                               Parent.SubMenuDetails.FBackground.Canvas.Handle,0,0,SRCCopy);
     end else
       For ax:=0 to wx do For ay:=0 to wy do
       if InItem Then
       DrawTransparentBitmap(Canvas,Parent.SubMenuDetails.Background,
                                    ax*Parent.SubMenuDetails.Background.Width,
                                    ay*Parent.SubMenuDetails.Background.Height,
                                       Parent.SubMenuDetails.TransparentColor);
  end else
  begin
    ax:=((SubMeasures.X)-(Parent.SubMenuDetails.Background.Width))  div 2;
    ay:=(SubMeasures.Y div 2)-(Parent.SubMenuDetails.Background.Height div 2);
    if Parent.SubMenuDetails.TransparentColor=clNone then
    begin
      Bitblt(Canvas.Handle,ax,ay,Parent.SubMenuDetails.Background.Width,
                                 Parent.SubMenuDetails.Background.Height,
                                 Parent.SubMenuDetails.Background.Canvas.Handle,0,0,SRCCopy);
    end else DrawTransparentBitmap(Canvas,Parent.SubMenuDetails.Background,
                                    ax,ay,Parent.SubMenuDetails.TransparentColor);
  end;
end;
var GlyBmp : TBitmap;
begin
 with ADrawItem.DrawItemStruct^ do
 begin
   FtempBmp:=TBitmap.Create;
   FTempBmp.Handle:=CreateCompatibleBitmap(HDC,rcItem.Right,rcItem.Bottom);
   with FTempBmp do
   try
     Canvas.Brush.Color:=clMenu;
     Canvas.FillRect(rcItem);
     BarRect:=rcItem;
     GlyRect:=rcItem;
     TxtRect:=rcItem;
   if not(ValidateType) then
   begin
     if (Parent.SubMenuDetails.BarEnabled) and
        (Parent.SubMenuDetails.Enabled)  then  BarRect.Right:=BarRect.Left+Parent.SubMenuDetails.BarWidth+1
     else BarRect.Right:=BarRect.Left;
     GlyRect.Left:=BarRect.Right;
     if ImageInMenuNoRoot then GlyRect.Right:=GlyRect.Left+GetAHMMenu.Images.Width+4 else GlyRect.Right:=GlyRect.Left;
     TxtRect.Left:=GlyRect.Right;
   end;
   if (Parent.SubmenuDetails.Enabled) then
       DrawSub(Canvas,Point(GlyRect.Right,rcItem.Top),Point(rcItem.Right,rcItem.Bottom));
   if ((ItemState and ODS_SELECTED) <> 0) then
   begin
     Canvas.Font:=GetAHMMenu.SelectedFont;
     if (GetAHMMenu.SelectedColor<>clNone) then
     begin
       Canvas.Brush.Color:=GetAHMMenu.SelectedColor;
       Canvas.FillRect(TxtRect);
     end else
     begin
       if (Parent.SubmenuDetails.Enabled) then Canvas.Brush.Color:=Parent.SubMenuDetails.Color
       else Canvas.Brush.Color:=clMenu;
        if not(Parent.SubmenuDetails.Enabled) then Canvas.FillRect(Rect(GlyRect.Left,GlyRect.Top,TxtRect.Right,GlyRect.Bottom));
     end;
   end else
   begin
     if (Parent.SubmenuDetails.Enabled) then Canvas.Brush.Color:=Parent.SubMenuDetails.Color
     else Canvas.Brush.Color:=clMenu;
     Canvas.Font:=GetAHMMenu.MenuFont;
     if not(Parent.SubmenuDetails.Enabled) then
      Canvas.FillRect(Rect(GlyRect.Left,GlyRect.Top,TxtRect.Right,GlyRect.Bottom));
   end;
   if Divider then
   begin
     SetBkMode(Canvas.Handle,1);
     Canvas.Font:=GetAHMMenu.DividerFont;
     if HasImage then TmpRect:=TxtRect else TmpRect:=GlyRect;
     TmpRect.Right:=rcItem.Right;
     DividerRect:=
     Rect(TmpRect.Left + ((TmpRect.Right-TmpRect.Left) div 2) - (Canvas.TextWidth(Caption) div 2)-1,
          TmpRect.Top  + ((TmpRect.bottom-TmpRect.Top) div 2) - (Canvas.TextHeight('W')    div 2)+1,
          TmpRect.Left + ((TmpRect.Right-TmpRect.Left) div 2) + (Canvas.TextWidth(Caption) div 2)+1,
          TmpRect.Top  + ((TmpRect.bottom-TmpRect.Top) div 2) + (Canvas.TextHeight('W')    div 2)+1);
     if Caption='-' then
     begin
       DividerRect.Left:=TmpRect.Right;
       DividerRect.Right:=TmpRect.Left;
     end;
     with TmpRect do
     begin
       Canvas.Pen.Width:=1;
       Canvas.Pen.Color:=clbtnShadow;
       Canvas.MoveTo(Left             ,Top + (Bottom - Top) div 2);
       Canvas.LineTo(DividerRect.Left ,Top + (Bottom - Top) div 2);
       Canvas.MoveTo(DividerRect.Right,Top + (Bottom - Top) div 2);
       Canvas.LineTo(Right            ,Top + (Bottom - Top) div 2);
       Canvas.Pen.Color:=clbtnHighlight;
       Canvas.MoveTo(Left             ,Top + 1+(Bottom - Top) div 2);
       Canvas.LineTo(DividerRect.Left ,Top + 1+(Bottom - Top) div 2);
       Canvas.MoveTo(DividerRect.Right,Top + 1+(Bottom - Top) div 2);
       Canvas.LineTo(Right            ,Top + 1+(Bottom - Top) div 2);
       if Caption<>'-' then
       DrawTextEx(Canvas.Handle,Pchar(Caption),-1,DividerRect,DT_VCenter or DT_Center,nil);
       SetBkMode(Canvas.Handle,OPAQUE);
     end;
   end;
   if not(Divider) or (Divider and HasImage) then
   begin
     if ImageInMenuNoRoot then
     begin
       ImgTopLeft.X:=GlyRect.Left+((GlyRect.Right-GlyRect.Left-GetAHMMenu.Images.Width) div 2);
       ImgTopLeft.Y:=GlyRect.Top+((GlyRect.Bottom-GlyRect.Top) div 2) - (GetAHMMenu.Images.Height div 2);
     end;
     If not(ValidateType) and HasImage then
     begin
       if HasImage then
       begin
         if ((ItemState and ODS_DISABLED) <> 0) and (FDisabledImageIndex>-1) then UseImageIndex:=FDisabledImageIndex else
         if (FCheckedIndex>-1) and ((ItemState and ODS_Checked)<>0) then UseImageIndex:=FCheckedIndex else
            UseImageIndex:=FImageIndex;
       end else UseImageIndex:=-1;
       if (UseImageIndex<GetAHMMenu.Images.Count) and (UseImageIndex>-1) then
       begin
         if ((ItemState and ODS_DISABLED)<>0) and (FDisabledImageIndex=-1) then
         begin
           glyBmp:=TBitmap.Create;
           try
             GetAHMMenu.Images.GetBitmap(UseImageIndex,GlyBmp);
             AHMDrawDisabledBitmap(GlyBmp.Canvas,0,0,GlyBmp);
             DrawTransparentBitmap(Canvas,GlyBmp,ImgTopLeft.X,ImgTopLeft.Y,GlyBmp.Canvas.Pixels[0,GlyBmp.Height-1]);
           finally
             glybmp.free;
           end;
         end else GetAHMMenu.Images.Draw(Canvas,ImgTopLeft.X,ImgTopLeft.Y,UseImageIndex);
         if HasImage and (UseImageIndex>-1) and ((ItemState and ODS_SELECTED)<>0) and ((ItemState and ODS_DISABLED)=0) then
         begin
           Canvas.Pen.Color:=clbtnHighlight;
           Canvas.Pen.Width:=1;
           Canvas.MoveTo(ImgTopLeft.X+GetAHMMenu.Images.Width+1,ImgTopLeft.Y-1);
           Canvas.LineTo(ImgTopLeft.X-1,ImgTopLeft.Y-1);
           Canvas.LineTo(ImgTopLeft.X-1,ImgTopLeft.Y+GetAHMMenu.Images.Height+1);
           Canvas.Pen.Color:=clbtnShadow;
           Canvas.LineTo(ImgTopLeft.X+GetAHMMenu.Images.Width+1,ImgTopLeft.Y+GetAHMMenu.Images.Height+1);
           Canvas.LineTo(ImgTopLeft.X+GetAHMMenu.Images.Width+1,ImgTopLeft.Y-1);
         end;
       end;
     end;
     if ((ItemState and ODS_DISABLED) <> 0) then Canvas.Font.Color:=clbtnShadow;
     SetBkMode(Canvas.Handle,1);
     if (ValidateType) and ((ItemState and ODS_SELECTED) = 0) and
        ((ItemState and ODS_DISABLED) = 0) then Canvas.Font.Color:=clMenutext;
     if ((ItemState and ODS_DISABLED) <> 0) and ((ItemState and ODS_SELECTED)=0) then DSMode:=DSS_DISABLED else DSMode:=DSS_NORMAL;
     if not(Divider) then
     begin
       if (FAsBitmapItem.HasBitmap) then
       begin
         if ((ItemState and ODS_DISABLED) = 0) and (FAsBitmapItem.TransparentColor<>clNone) then
             DrawTransparentBitmap(Canvas,FAsBitmapItem.Bitmap,TxtRect.Left,TxtRect.Top,FAsBitmapItem.TransparentColor)
         else
             DrawState(Canvas.Handle,0,nil,LPARAM(PChar(FAsBitmapItem.Bitmap.Handle)),0,TxtRect.Left,TxtRect.Top
                   ,0,0,DST_BITMAP or dsMode);
        end;
        if not(FAsBitmapItem.HasBitmap) or ((FAsBitmapItem.HasBitmap) and (FAsBitmapItem.CaptionOnTop)) then
        if not(getparentComponent is TAHMMainMenu) then
          DrawState(Canvas.Handle,0,nil,LPARAM(PChar(Caption)),0,TxtRect.left+2,TxtRect.Top+((
                    TxtRect.Bottom-TxtRect.Top) div 2)-(Canvas.TextHeight('W') div 2),0,0,DST_PREFIXTEXT or dsMode)
        else DrawState(Canvas.Handle,0,nil,LPARAM(PChar(Caption)),0,TxtRect.left+((TxtRect.Right-TxtRect.Left-Canvas.TextWidth(Caption)) div 2),TxtRect.Top+((
                    TxtRect.Bottom-TxtRect.Top) div 2)-(Canvas.TextHeight('W') div 2),0,0,DST_PREFIXTEXT or dsMode);
       if (ShortCut>0) and not(ValidateType) then
         DrawState(Canvas.Handle,0,nil,LPARAM(PChar(ShortCutToText(ShortCut))),0,TxtRect.Right-Canvas.TextWidth(ShortCutToText(shortCut)+#9+'W'),TxtRect.Top+((
               TxtRect.Bottom-TxtRect.Top) div 2)-(Canvas.TextHeight('W') div 2),0,0,DST_PREFIXTEXT or dsMode)
       end;
    end;
    if ((ItemState and ODS_SELECTED) <> 0) then
    if GetAHMMenu.Selecttype<>SelNormal then
    begin
      if GetAHMMenu.Selecttype=SelRaised then Canvas.Pen.Color:=clbtnHighlight
                                           else Canvas.Pen.Color:=clbtnShadow;
       Canvas.Pen.Width:=1;
       Canvas.MoveTo(TxtRect.Right-1,TxtRect.Top);
       Canvas.LineTo(TxtRect.Left,TxtRect.Top);
       Canvas.LineTo(TxtRect.Left,TxtRect.Bottom-1);
       if GetAHMMenu.Selecttype=SelRaised then Canvas.Pen.Color:=clbtnShadow
                                           else Canvas.Pen.Color:=clbtnHighlight;
       Canvas.LineTo(TxtRect.Right-1,TxtRect.Bottom-1);
       Canvas.LineTo(TxtRect.Right-1,TxtRect.Top);
    end;

    if not(ValidateType) then DoBar(Canvas.Handle,BarRect);
  finally
    BitBlt(HDC,rcItem.Left,rcItem.Top,rcItem.right-rcItem.left,rcItem.bottom-rcItem.top,
           Canvas.Handle,rcItem.Left,rcItem.Top,SrcCopy);
    FTempBmp.Free;
  end;
  end;
end;
procedure TAHMMenuItem.MeasureMenuItem(var AMeasureItem : TWMMeasureItem);
var
  Canvas: TCanvas;
  Actual,txtw : Integer;
  SetFont : TFont;
  ResPoint: TPoint;
  MeasCaption : String;
  I: Integer;
  WShortCut: Integer;

Function GetFontSize(CurrentSize:TPoint;NewFont : TFont) : TPoint;
begin
  Canvas.Font:=NewFont;
  if Canvas.Textwidth(MeasCaption)>CurrentSize.X then
  begin
    Result.X:=Canvas.Textwidth(MeasCaption);
    SetFont:=NewFont;
  end else Result.X:=CurrentSize.X;
  if Canvas.TextHeight(MeasCaption)>CurrentSize.Y then
     Result.Y:=Canvas.TextHeight(MeasCaption) else Result.Y:=CurrentSize.Y;
end;
begin
  Canvas := TCanvas.Create;
  Canvas.Handle:=GetDC(0);
  with AMeasureItem.MeasureItemStruct^  do
  begin
    if Caption='' then MeasCaption:='W' else MeasCaption:=FCaption;
    respoint.x:=0; respoint.y:=0;
    resPoint := GetFontSize(GetFontSize(GetFontSize(respoint,
                GetAHMMenu.SelectedFont),GetAHMMenu.DividerFont),GetAHMMenu.MenuFont);
    Canvas.Font := SetFont;
    if ImageInMenuNoRoot then txtw:=GetAHMMenu.Images.Width+4 else txtw:=Canvas.Textwidth('W');
    if (Parent.SubMenuDetails.Enabled) then
    if (Parent.SubMenuDetails.BarEnabled) then txtw:=txtw+Parent.SubMenuDetails.BarWidth;
    if not(FAsBitmapItem.HasBitmap) then
    begin
      if (ValidateType) then Actual:=Canvas.TextWidth(MeasCaption)
                        else Actual:=Canvas.TextWidth(MeasCaption+#9);
    end else
    begin
      Actual:=FAsBitmapItem.Bitmap.Width;
      if (ValidateType) then Actual:=Actual+Canvas.Textwidth('W');
    end;
    WShortCut := 0;
    if not (ValidateType) then
    begin
      for I := 0 to Parent.Count - 1 do
      if Canvas.TextWidth(ShortCutToText(Parent.Items[i].ShortCut))>WShortCut then
      WShortCut :=Canvas.TextWidth(ShortCutToText(Parent.Items[i].ShortCut));
    end;
    if GetParentComponent is TAHMMainMenu then txtw:=respoint.x else txtw := txtw + Actual + WShortCut;
    if not(FAsBitmapItem.HasBitmap) then ItemHeight := resPoint.y else ItemHeight := FAsBitmapItem.Bitmap.Height;
    if (GetCount>0) and not(GetParentComponent is TAHMMainMenu) then txtw:=txtw+Canvas.Textwidth(#9);
    if HasImage then
    if (Itemheight<DWord(GetAHMMenu.Images.Height+3)) then Itemheight := GetAHMMenu.Images.Height + 3;
    if (Itemheight<DWord(GetSystemMetrics(SM_CYMENU))) then Itemheight := GetSystemMetrics(SM_CYMENU);
    ItemWidth   := txtw+2;
    FItemHeight := ItemHeight;
    FItemWidth  := txtw + Canvas.TextWidth('W')+2;
  end;
  Canvas.Free;
end;

Function MyHookProc(code: Integer; wparam: WPARAM; lparam: LPARAM): LRESULT; stdcall;
var MyHookKeyDown : TWMKey;
    I : Integer;
procedure KillMessage;
begin
  FillChar(PMsg(lparam)^,SizeOf(TMsg),0);
end;
begin
  result:=0;
  if (Code>=0) and (ActiveMenu=0) then
  begin
    case PMsg(lparam)^.Message of
      WM_KEYDOWN,WM_SYSKEYDOWN :
      if CurrentMenu<>nil then
      begin
        MyHookKeyDown.Msg := PMsg(lparam)^.Message;
        MyHookKeyDown.CharCode:=PMsg(lparam)^.wparam;
        MyHookKeyDown.KeyData:=PMsg(lparam)^.lparam;
        with TWincontrol(CurrentMenu.Owner) do
        for I:=0 to TWincontrol(CurrentMenu.Owner).ComponentCount-1 do
        If (TWincontrol(CurrentMenu.Owner).Components[I] is TAHMMenu) then
        if TAHMMenu(TWincontrol(CurrentMenu.Owner).Components[I]).IsShortCut(MyHookKeyDown) then
        begin
          KillMessage;
          Exit;
        end;
      end;
    end;
  end else Result:=CallNextHookEx(HKeyHook,Code,wParam,lParam);
end;

constructor TAHMMenu.Create(AOwner: TComponent);
var doraise:Boolean;
    I,O : Integer;
procedure ImportOld(SOwner : TAHMMenuItem;SMenuItem : TMenuItem);
var AHMMenuItem : TAHMMenuItem;
     S : Integer;
begin
  AHMMenuItem:=TAHMMenuItem.Create(Owner);
  AHMMenuItem.Caption:=SMenuItem.Caption;
  AHMMenuItem.ShortCut:=SMenuItem.ShortCut;
  AHMMenuItem.OnClick:=SMenuItem.OnClick;
  AHMMenuItem.Checked:=SMenuItem.Checked;
  AHMMenuItem.Enabled:=SMenuItem.Enabled;
  AHMMenuItem.Visible:=SMenuItem.Visible;
  AHMMenuItem.RadioItem:=SMenuItem.RadioItem;
  AHMMenuItem.GroupIndex:=SMenuItem.GroupIndex;
  AHMMenuItem.Hint:=SMenuItem.Hint;
  AHMMenuItem.Default:=SMenuItem.Default;
  AHMMenuItem.Name:='AHM'+SMenuItem.Name;
  AHMMenuItem.HelpContext:=SMenuItem.HelpContext;
  {$IFDEF AHMINPRISE4}
  AHMMenuItem.Action:=SMenuItem.Action;
  AHMMenuItem.ImageIndex:=SMenuItem.ImageIndex;
  AHMMenuItem.CheckedIndex:=SMenuItem.ImageIndex;
  If SMenuItem.Caption='-' then AHMMenuItem.Divider:=True;
  {$ENDIF}
  if SMenuItem.Owner=nil then Self.Owner.InsertComponent(AHMMenuItem);
  SOwner.Add(AHMMenuItem);
  if SMenuItem.Count>0 then
  for S:=0 to SMenuItem.Count-1 do ImportOld(AHMMenuItem,SMenuItem.Items[S]);
end;
begin
  FItems := TAHMMenuItem.Create(self);
  FItems.OnClick := DoPopup;
  FItems.FOnChange := MenuChanged;
  DoRaise:=False;
  FItems.FMenu := Self;
  FNewStyles := True;
  FSelectedColor := clHighlight;
  FCursor := crDefault;
  FSelectType:=selNormal;
  inherited Create(AOwner);
  If (self is TAHMMainMenu) and (AOwner is TWinControl) then
  For I:=0 to AOwner.Componentcount-1 do
  begin
    if (AOwner.Components[I] is TMainMenu) then
    begin
       {$IFDEF AHMINPRISE4}
      Images:=(AOwner.Components[I] as TMainMenu).Images as TImageList;
      {$ENDIF}
      try
        For O:=0 to (AOwner.Components[I] as TMainMenu).Items.Count-1 do
          ImportOld(self.FItems,(AOwner.Components[I] as TMainMenu).Items.Items[O]);
      finally
        (AOwner.Components[I]).Free;
      end;
      Break;
    end else
    if ((AOwner.Components[I] is TAHMMainMenu) and (AOwner.Components[I]<>self)) then doraise:=True;
  end;
  FAutoPopup := True;
  FImageChangeLink := TChangeLink.Create;
  FImageChangeLink.OnChange := ImageListChange;
  FFont:=TFont.Create;
  FSelectedFont:=TFont.Create;
  FDividerFont:=TFont.Create;
  FFont.OnChange:=FontChange;
  FSelectedFont.OnChange:=FontChange;
  FDividerFont.OnChange:=FontChange;
  if (csDesigning in ComponentState) then
  begin
    FSelectedFont.Color:=clHighlightText;
    FDividerFont.Name:='Small Fonts';
    FDividerFont.Size:=7;
  end;
  if ((Self is TAHMMainMenu) or (Self is TAHMFormMenu)) and not(AOwner is TWinControl) then
     raise EDuplicateMainMenu.Create(self.Classname+ahmmnuinvalidowner)
  else
  begin
    SetWindowHandle(GetWindowHandle);
    FHookClass:=TAHMMenuHookClass(MenuHookList.Add(self,AOwner,((Self is TAHMMainMenu) or (Self is TAHMFormMenu))));
    FHookClass.OnReloadMenuHook:=ReloadHook;
    FHookClass.BeforeReload:=BeforeReloadHook;
    FHookClass.BeforeMessage:=WndProc;
    if not(DoRaise) then
    begin
      if not(self is TAHMPopupMenu) then SetMenu;
      self.SetOwnerDrawAll;
      if not(CsDesigning in Componentstate) then
      begin
        if HKeyHook=0 then HKeyHook:= SetWindowsHookEx(wh_GetMessage,MyHookProc,0,GetCurrentThreadID);
        if CurrentMenu=nil then CurrentMenu:=self;
      end;
    end else raise EDuplicateMainMenu.Create(ahmmnuduplicatemainmenu);
  end;
end;

Function TAHMMenu.GetWindowHandle : HWnd;
begin
  if not(Owner is TWinControl) then
  begin
   FWindowHandle:=0;
   result:=0;
   exit;
  end;
  FWindowHandle:=TWincontrol(Owner).Handle;
  if (self is TAHMMainMenu) then
  begin
    if (Owner is TForm) then
    begin
      if not(csDesigning in Componentstate) then
      if (TForm(Owner).Formstyle=fsMdiChild) then
      begin
        FWindowHandle:=Application.Mainform.Handle;
      end;
    end;
  end else
  if (self is TAHMFormMenu) then FWindowHandle:=TWincontrol(Owner).Handle else FWindowHandle:=Application.Handle;
  result:=FWindowHandle;
end;

procedure TAHMMenu.FontChange(Sender : TObject);
begin
  SendMessage(FWindowHandle, CM_MENUCHANGED, 0, 0);
end;

procedure TAHMMenu.SetSelectType(Value : TAHMSelectType);
begin
  FSelectType:=Value;
end;

procedure TAHMMenu.SetMenuFont(Value : TFont);
begin
  FFont.Assign(Value);
end;

procedure TAHMMenu.SetNewStyles(Value : Boolean);
begin
  FNewStyles:=Value;
  SetOwnerDrawAll;
  DrawMenuBar(FWindowHandle);
  if (Owner is TWincontrol) then TWincontrol(Owner).Refresh;
end;

procedure TAHMMenu.SetSelectedFont(Value : TFont);
begin
  FSelectedFont.Assign(Value);
end;

procedure TAHMMenu.SetDividerFont(Value : TFont);
begin
  FDividerFont.Assign(Value);
end;

procedure TAHMMenu.SetMenu;
begin
  if not(Owner is TWinControl) then exit;
  if (csDesigning in ComponentState) then
  begin
    if TWincontrol(Owner).HandleAllocated then
    begin
      if Windows.GetMenu(TWinControl(Owner).Handle) <> Handle then
         Windows.SetMenu(TWincontrol(Owner).Handle, Handle);
         WindowHandle := TWincontrol(Owner).Handle;
    end;
  end else Windows.SetMenu(TWincontrol(Owner).Handle,Handle);
end;

procedure TAHMMenu.Loaded;
begin
  inherited Loaded;
  if (self is TAHMMainMenu) then
  begin
    BeforeReloadHook(Self);
    FHookClass.UpdateMenuHooks;
    ReloadHook(Self);
  end else FHookClass.UpdateMenuHooks;
end;

procedure TAHMMenu.Notification(AComponent: TComponent; Operation: TOperation);
begin
  inherited Notification(AComponent, Operation);
  if (Operation = opRemove) and (AComponent is TAHMMenu) and (AComponent = CurrentMenu) then
  begin
    if not(CsDesigning in Componentstate) then
    begin
      HKeyHook:= SetWindowsHookEx(wh_GetMessage,MyHookProc,0,GetCurrentThreadID);
      CurrentMenu:=self;
    end;
  end;
  if (Operation = opRemove) and (AComponent is TAHMMainMenu) then
  begin
    if (Owner is TWinControl) then TWincontrol(Owner).Refresh;
  end;
  if (Operation = opInsert) and (AComponent is TAHMMainMenu) then
  begin
    if (Owner is TWinControl) then TWincontrol(Owner).Refresh;
  end;
  if (Operation = opInsert) and (AComponent is TMainMenu) then
  if (Owner is TWinControl) and (AComponent.Owner is TWinControl) then
  if ((AComponent.Owner as TWinControl)=(self.Owner as TWinControl)) then
  begin
    raise Exception.Create('You can not use a TMainMenu in conjunction with TAHMMainMenu ');
  end;
  if (Operation = opRemove) and (FImages <> nil) and (AComponent = FImages) then
  begin
    FImages:=nil;
  end;
end;


destructor TAHMMenu.Destroy;
begin
  If HKeyHook<>0 then
  begin
    UnhookWindowsHookEx(HKeyHook);
    HKEyHook:=0;
  end;
  CurrentMenu:=nil;
  FImages:=nil;
  FImageChangeLink.Free;
  FItems.Free;
  FSelectedFont.OnChange:=nil;
  FDividerFont.OnChange:=nil;
  FFont.OnChange:=nil;
  FSelectedFont.Free;
  FDividerFont.Free;
  FFont.Free;
  MenuHookList.Remove(Self);
  inherited Destroy;
end;

procedure TAHMMenu.SetOwnerDrawAll;
const
  IBreaks: array [TAHMMenuBreak] of Longint = (MF_STRING, MF_MENUBREAK, MF_MENUBARBREAK);
  IEnables: array [Boolean] of Longint = (MF_DISABLED or MF_GRAYED, MF_ENABLED);
  ISeparators: array [Boolean] of Longint = (MF_STRING, MF_SEPARATOR);
  LSeparators: array [Boolean] of Longint = (0, MF_SEPARATOR);
  IChecks: array [Boolean] of Longint = (MF_UNCHECKED, MF_CHECKED);
  IRadios: array[Boolean] of Longint = (MFT_STRING, MFT_RADIOCHECK);
  IDefaults: array [Boolean] of Longint = (0, MF_DEFAULT);
  IPopup: array[Boolean] of Longint = (0,MF_POPUP);
  IBitmap: array[Boolean] of LongInt = (0,MF_BITMAP);
  IJustify: array[Boolean] of Byte = (0, 1);
var TotalLoop : Integer;
procedure ModifyMenuItem(AMenuItem : TAHMMenuItem);
var Flags,I : Integer;
    MenuPChar : PChar;
begin
 Flags := IBreaks[AMenuItem.Break]
           or IEnables[AMenuItem.Enabled]
           or LSeparators[AMenuItem.Divider]
           or IChecks[AMenuItem.Checked]
           or IRadios[AMenuItem.RadioItem]
           or IBitmap[not(FNewStyles) and (AMenuItem.FAsBitmapItem.Bitmap.Width>0) and (AMenuItem.FAsBitmapItem.Bitmap.Height>0)]
           or IDefaults[AMenuItem.Default];
  if FNewStyles then
  begin
    Flags:=Flags or MF_OWNERDRAW;
    MenuPChar:=PChar(0);
  end else
  if (AMenuItem.ValidateType) then MenuPChar:=PChar(AMenuItem.Caption) else
     MenuPChar:=PChar(AMenuItem.Caption+#9+ShortCutToText(AMenuItem.ShortCut));
  if not(FNewStyles) then
  if ((AMenuItem.FAsBitmapItem.Bitmap.Width>0) and (AMenuItem.FAsBitmapItem.Bitmap.Height>0)) then
  MenuPChar:=PChar(LoWord(AMenuItem.FasBitmapItem.Bitmap.handle));
  ModifyMenu(Handle, AMenuItem.FCommand, Flags, AMenuItem.Command,MenuPChar);
  For I:=0 to AMenuItem.count-1 do ModifyMenuItem(AMenuItem.Items[I]);
end;
begin
  for TotalLoop:=0 to Items.Count-1 do ModifyMenuItem(Items[TotalLoop]);
end;

procedure TAHMMenu.SetSelectedColor(Value : TColor);
begin
  FSelectedColor:=Value;
  SendMessage(WindowHandle, CM_MENUCHANGED, 0, 0);
end;


Function CheckMenuChar(AItem : TAHMMenuItem;var Msg : TMessage):Boolean;
var Index : Integer;
    Found : Boolean;
begin
  Found:=false;
  with AItem do
  begin
    if Visible and Enabled and (Caption <> '') then
    if (AItem.Parent.FHandle = TWMMenuChar(Msg).Menu) then
    if (LowerCase(TWMMenuChar(Msg).User)=LowerCase(Caption[Pos('&',Caption)+1])) then
    begin
      Msg.ResultHi := 2;
      Msg.ResultLo := AItem.MenuIndex;
      result:=true;
      Exit;
    end;
  end;
  if Not(Found) then
  For Index:=0 to AItem.Count-1 do
  if not(Found) then Found:=CheckMenuChar(AItem.Items[Index],Msg);
  result:=Found;
end;

procedure TAHMMenu.WndProc(var Message: TMessage;var Handled : Boolean);
Var AHMMenuItem : TAHMMenuItem;
    SelectContext : THelpContext;
begin
  try
    case Message.msg of
      WM_ENTERMENULOOP:
      begin
        Activemenu:=Handle;
        SetOwnerDrawAll;
        DrawMenuBar(FWindowHandle);
        Handled:=True;
      end;
      WM_EXITMENULOOP:
      begin
        ActiveMenu:=0;
        Handled:=True;
      end;
      CM_MENUCHANGED,
      WM_SYSCOLORCHANGE :
      begin
        SetOwnerDrawAll;
        DrawMenuBar(GetWindowHandle);
        Handled:=True;
      end;
      WM_INITMENUPOPUP : if DispatchPopup(TWMInitMenuPopup(Message).MenuPopup) then  Exit;
      WM_MEASUREITEM :
      with TWMMeasureItem(Message).MeasureItemStruct^ do
      If FNewStyles and (CtlType = ODT_MENU) then
      begin
        AHMMenuItem:=FindItem(ItemID,fkCommand);
        if AHMMenuItem<>nil then
        begin
          if (AHMMenuItem.Visible) then
          AHMMenuItem.MeasureMenuItem(TWMMeasureItem(Message));
          Handled:=True;
        end;
      end;
      WM_DRAWITEM :
      with TWMDrawItem(Message).DrawItemStruct^ do
      If FNewStyles and (CtlType =ODT_MENU) then
      begin
        AHMMenuItem:=FindItem(ItemID,fkCommand);
        if AHMMenuItem<>nil then
        begin
          if (AHMMenuItem.Visible) and
          not(((ItemState and ODS_SELECTED) <> 0) and ((ItemState and ODS_DISABLED) <> 0)) then
          AHMMenuItem.DrawMenuItem(TWMDrawItem(Message));
          Handled:=True;
        end else if (ItemID AND 65520)>=61440 then
        begin
          AHMMenuItem:=FindItem((ItemID AND 65520),fkCommand);
          if AHMMenuItem<>nil then
          begin
            if AHMMenuItem.Visible then AHMMenuItem.DrawMenuItem(TWMDrawItem(Message));
            Handled:=True;
          end;
        end;
      end;
      WM_COMMAND : if DispatchCommand(TWMCommand(Message).ItemID) then         Handled:=True;
      WM_SYSCOMMAND :
      if TWMSysCommand(Message).CmdType<61440 then
      begin
        DispatchCommand(TWMCommand(Message).ItemID);
        Handled:=True;
      end;
      WM_MENUCHAR : if CheckMenuChar(Items,Message) then Exit;
      WM_SETCURSOR :
      if FNewStyles then
      with TWMSetCursor(Message) do
      begin
        if (FCursor <> crDefault) AND (FCursor <> crArrow) and (MouseMsg = 0) then
        begin
          SetCursor(Screen.Cursors[FCursor]);
          Handled:=True;
        end;
      end;
      WM_HELP :
      with PHelpInfo(Message.LParam)^ do
      begin
        SelectContext:=GetHelpContext(iCtrlID, True);
        if SelectContext = 0 then SelectContext:=GetHelpContext(hItemHandle, False);
        if Screen.ActiveForm = nil then Exit;
        if (biHelp in Screen.ActiveForm.BorderIcons) then
             Application.HelpCommand(HELP_CONTEXTPOPUP, SelectContext)
        else Application.HelpContext(SelectContext);
//        Exit;
      end;
      WM_MENUSELECT:
        with TWMMenuSelect(Message) do
        begin
          if MenuFlag and MF_POPUP <> 0 then AHMMenuItem := FindItem(GetSubMenu(Menu,IDItem),fkHandle)
          else AHMMenuItem := FindItem(IDItem,fkCommand);
          if AHMMenuItem <> nil then
          begin
            if Assigned(AHMMenuItem.FOnSelect) then AHMMenuItem.FOnSelect(self);
            if Assigned(FOnHint) then FOnHint(self,GetLongHint(AHMMenuItem.Hint),GetShortHint(AHMMenuItem.Hint));
            Application.Hint := GetLongHint(AHMMenuItem.Hint);
            Handled:=True;
          end;
          Application.Hint := '';
        end;

    end;
  except
    Application.HandleException(self);
  end;
end;

{$IFNDEF AHMINPRISE3}
procedure TAHMMenu.GetChildren(Proc: TGetChildProc);
begin
  FItems.GetChildren(Proc);
end;
{$ELSE}
procedure TAHMMenu.GetChildren(Proc: TGetChildProc; Root: TComponent);
begin
  FItems.GetChildren(Proc, Root);
end;
{$ENDIF}

function TAHMMenu.GetHandle: HMENU;
begin
  Result := FItems.GetHandle;
end;

procedure TAHMMenu.SetChildOrder(Child: TComponent; Order: Integer);
begin
  FItems.SetChildOrder(Child, Order);
end;

function TAHMMenu.FindItem(Value: Integer; Kind: TAHMFindItemKind): TAHMMenuItem;
var FoundItem : TAHMMenuItem;
function Find(Item: TAHMMenuItem): Boolean;
var I: Integer;
begin
  Result := False;
  if ((Kind = fkCommand) and (Value = Item.Command)) or
     ((Kind = fkHandle) and (Value = Integer(Item.FHandle))) or
     ((Kind = fkShortCut) and (Value = Item.ShortCut)) then
  begin
    FoundItem := Item;
    Result := True;
    Exit;
  end else
  for I := 0 to Item.GetCount -1 do
  if Find(Item[I]) then
  begin
    Result := True;
    Exit;
  end;
end;

begin
  FoundItem := nil;
  IterateMenus(@Find, Items.FMerged, Items);
  Result := FoundItem;
end;

function TAHMMenu.GetHelpContext(Value: Integer; ByCommand: Boolean): THelpContext;
var
  Item: TAHMMenuItem;
  Kind: TAHMFindItemKind;
begin
  Result := 0;
  Kind := fkHandle;
  if ByCommand then Kind := fkCommand;
  if (Kind = fkHandle) and (Self is TAHMPopupMenu) and
    (TAHMPopupMenu(Self).Handle = Dword(Value)) then
    Result := TAHMPopupMenu(Self).HelpContext
  else
  begin
    Item := FindItem(Value, Kind);
    while (Item <> nil) and (Item.HelpContext = 0) do
      Item := Item.FParent;
    if Item <> nil then Result := Item.HelpContext;
  end;
end;

function TAHMMenu.DispatchCommand(ACommand: Word): Boolean;
var  Item: TAHMMenuItem;
begin
  Result := False;
  Item := FindItem(ACommand, fkCommand);
  if Item <> nil then
  begin
    Item.Click;
    Result := True;
  end;
end;

function TAHMMenu.DispatchPopup(AHandle: HMENU): Boolean;
var
  Item: TAHMMenuItem;
begin
  Result := False;
  Item := FindItem(AHandle, fkHandle);
  if Item <> nil then
  begin
    {$IFDEF AHMINPRISE4}
    if not (csDesigning in Item.ComponentState) then TAHMMenuItem(Item).InitiateActions;
    {$ENDIF}
    TAHMMenuItem(Item).Click;
    Result := True;
  {$IFNDEF AHMINPRISE4}
  end;
  {$ELSE}
  end
  else if not (csDesigning in ComponentState) and (Self is TPopupMenu) then Items.InitiateActions;
  {$ENDIF}
end;

function TAHMMenu.IsShortCut(var Message: TWMKey): Boolean;
type TClickResult = (crDisabled, crClicked, crShortCutMoved);
const AltMask = $20000000;
var ShortCut: TShortCut;
    ShortCutItem: TAHMMenuItem;
    ClickResult: TClickResult;
function DoClick(Item: TAHMMenuItem): TClickResult;
begin
  Result := crClicked;
  if Item.Parent <> nil then Result := DoClick(Item.Parent);
  if Result = crClicked then
  if Item.Enabled then
  try
    {$IFDEF AHMINPRISE4}
    if not (csDesigning in ComponentState) then Item.InitiateActions;
    {$ENDIF}
    Item.Click;
    if ShortCutItem.ShortCut <> ShortCut then Result := crShortCutMoved;
  except
    Application.HandleException(Self);
  end else Result := crDisabled;
end;
begin
  Result := False;
  if (Self.Owner is TWinControl) then
  if GetActiveWindow <> TWinControl(Self.Owner).Handle then  Exit;
  if FWindowHandle <> 0 then
  begin
    ShortCut := Byte(Message.CharCode);
    if GetKeyState(VK_SHIFT) < 0 then Inc(ShortCut, scShift);
    if GetKeyState(VK_CONTROL) < 0 then Inc(ShortCut, scCtrl);
    if Message.KeyData and AltMask <> 0 then Inc(ShortCut, scAlt);
    repeat
      ClickResult  := crDisabled;
      ShortCutItem := FindItem(ShortCut, fkShortCut);
      if ShortCutItem <> nil then ClickResult := DoClick(ShortCutItem);
    until ClickResult <> crShortCutMoved;
    Result := ShortCutItem <> nil;
  end;
end;

function TAHMMenu.UpdateImage: Boolean;
var
  Image: array[0..511] of Char;

  procedure BuildImage(Menu: HMENU);
  var
    P, ImageEnd: PChar;
    I, C: Integer;
    State: Word;
  begin
    C := GetMenuItemCount(Menu);
    P := Image;
    ImageEnd := @Image[SizeOf(Image) - 5];
    I := 0;
    while (I < C) and (P < ImageEnd) do
    begin
      GetMenuString(Menu, I, P, ImageEnd - P, MF_BYPOSITION);
      P := StrEnd(P);
      State := GetMenuState(Menu, I, MF_BYPOSITION);
      if State and MF_DISABLED <> 0 then P := StrECopy(P, '$');
      if State and MF_MENUBREAK <> 0 then P := StrECopy(P, '@');
      if State and MF_GRAYED <> 0 then P := StrECopy(P, '#');
      P := StrECopy(P, ';');
      Inc(I);
    end;
  end;

begin
  Result := False;
  Image[0] := #0;
  if FWindowHandle <> 0 then BuildImage(Handle);
  if (FMenuImage = '') or (StrComp(PChar(FMenuImage), Image) <> 0) then
  begin
    Result := True;
    FMenuImage := Image;
  end;
end;

procedure TAHMMenu.SetWindowHandle(Value: HWND);
begin
  FWindowHandle := Value;
  UpdateImage;
end;

procedure TAHMMenu.MenuChanged(Sender: TObject;{$IFDEF AHMINPRISE4}Source : TMenuItem;{$ENDIF} Rebuild: Boolean);
begin

end;

procedure TAHMMainMenu.Loaded;
begin
  inherited Loaded;
end;

procedure TAHMMainMenu.SetAutoMerge(Value: Boolean);
begin
  if FAutoMerge <> Value then
  begin
    FAutoMerge := Value;
    if WindowHandle <> 0 then
      SendMessage(WindowHandle, CM_MENUCHANGED, 0, 0);
  end;
end;

procedure TAHMMenu.SetImages(Value: TImageList);
begin
  if Images <> nil then
  begin
    Images.UnRegisterChanges(FImageChangeLink);
  end;
  FImages := Value;
{ Removed because of exception
  if Images <> nil then
  begin
    Images.RegisterChanges(FImageChangeLink);
  end;}
end;

procedure TAHMMenu.ImageListChange(Sender: TObject);
begin
  SetImages(TImageList(Sender));
  SendMessage(WindowHandle, CM_MENUCHANGED, 0, 0);
end;
 
procedure TAHMMainMenu.MenuChanged(Sender: TObject;{$IFDEF AHMINPRISE4}Source : TMenuItem;{$ENDIF} Rebuild: Boolean);
begin
  if (FWindowHandle <> 0) and UpdateImage then DrawMenuBar(FWindowHandle);
end;

procedure TAHMMainMenu.Merge(Menu: TAHMMainMenu);
begin
  if Menu <> nil then
    FItems.MergeWith(Menu.FItems) else
    FItems.MergeWith(nil);
end;

procedure TAHMMainMenu.Unmerge(Menu: TAHMMainMenu);
begin
  if (Menu <> nil) and (FItems.FMerged = Menu.FItems) then
    FItems.MergeWith(nil);
end;

procedure TAHMMainMenu.ItemChanged;
begin
  MenuChanged(nil,{$IFDEF AHMINPRISE4}nil,{$ENDIF} False);
  if FWindowHandle <> 0 then
    SendMessage(FWindowHandle, CM_MENUCHANGED, 0, 0);
end;

function TAHMMainMenu.GetHandle: HMENU;
begin
  if FOle2Menu <> 0 then
    Result := FOle2Menu else
    Result := inherited GetHandle;
end;

procedure TAHMMainMenu.GetOle2AcceleratorTable(var AccelTable: HAccel;
  var AccelCount: Integer; Groups: array of Integer);
var
  NumAccels: Integer;
  AccelList, AccelPtr: PAccel;

  procedure ProcessAccels(Item: TAHMMenuItem);
  var
    I: Integer;
    Virt: Byte;
  begin
    if Item.ShortCut <> 0 then
      if AccelPtr <> nil then
      begin
        Virt := FNOINVERT or FVIRTKEY;
        if Item.ShortCut and scCtrl <> 0 then Virt := Virt or FCONTROL;
        if Item.ShortCut and scAlt <> 0 then Virt := Virt or FALT;
        if Item.ShortCut and scShift <> 0 then Virt := Virt or FSHIFT;
        AccelPtr^.fVirt := Virt;
        AccelPtr^.key := Item.ShortCut and $FF;
        AccelPtr^.cmd := Item.Command;
        Inc(AccelPtr);
      end else
        Inc(NumAccels)
    else
      for I := 0 to Item.GetCount - 1 do ProcessAccels(Item[I]);
  end;

  function ProcessAccelItems(Item: TAHMMenuItem): Boolean;
  var
    I: Integer;
  begin
    for I := 0 to High(Groups) do
      if Item.GroupIndex = Groups[I] then
      begin
        ProcessAccels(Item);
        Break;
      end;
    Result := False;
  end;

begin
  NumAccels := 0;
  AccelPtr := nil;
  IterateMenus(@ProcessAccelItems, Items.FMerged, Items);
  AccelTable := 0;
  if NumAccels <> 0 then
  begin
    GetMem(AccelList, NumAccels * SizeOf(TAccel));
    AccelPtr := AccelList;
    IterateMenus(@ProcessAccelItems, Items.FMerged, Items);
    AccelTable := CreateAcceleratorTable(AccelList^, NumAccels);
    FreeMem(AccelList);
  end;
  AccelCount := NumAccels;
end;

procedure TAHMMainMenu.PopulateOle2Menu(SharedMenu: HMenu;
  Groups: array of Integer; var Widths: array of Longint);
var
  NumGroups: Integer;
  J: Integer;

  function AddOle2(Item: TAHMMenuItem): Boolean;
  var
    I: Integer;
  begin
    for I := 0 to NumGroups do
    begin
      if Item.GroupIndex = Groups[I] then
      begin
        Inc(Widths[Item.GroupIndex]);
        Item.AppendTo(SharedMenu);
      end;
    end;
    Result := False;
  end;

begin
  NumGroups := High(Groups);
  for J := 0 to High(Widths) do Widths[J] := 0;
  IterateMenus(@AddOle2, Items.FMerged, Items);
end;

procedure TAHMMainMenu.SetOle2MenuHandle(Handle: HMENU);
begin
  FOle2Menu := Handle;
  ItemChanged;
end;

constructor TAHMPopupMenu.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  
  OSubmenu:=Items.SubMenuDetails;
  FPopupDetails:=TAHMSubMenu.Create(Self,Items);
  FPopupDetails.OnChange:=ChangeSubMenu;
end;

procedure TAHMPopupMenu.Loaded;
begin
  inherited Loaded;
end;

Procedure TAHMPopupMenu.ChangeSubMenu(Sender : TObject);
begin
  AHMWorkInx:=nil;
  Items.SubMenuDetails:=PopupDetails;
end;

destructor TAHMPopupMenu.Destroy;
begin
  Items.SubmenuDetails:=OSubMenu;
  OSubMenu:=nil;
  if FPopupDetails<>nil then
  begin
    FPopupDetails.OnChange:=nil;
    FPopupDetails.Free;
  end;
  inherited Destroy;
end;

function TAHMPopupMenu.GetHelpContext: THelpContext;
begin
  Result := FItems.HelpContext;
end;

procedure TAHMPopupMenu.SetHelpContext(Value: THelpContext);
begin
  FItems.HelpContext := Value;
end;

procedure TAHMMenu.DoPopup(Item: TObject);
begin
  if Assigned(FOnPopup) then FOnPopup(Item);
end;

procedure TAHMMenu.Popup(X, Y: Integer);
const
  Flags: array[TPopupAlignment] of Word = (TPM_LEFTALIGN, TPM_RIGHTALIGN,
    TPM_CENTERALIGN);
  var OldHandle,NewHandle : Integer;
begin
  DoPopup(Self);
  if (self is TAHMMainMenu) then
  begin
    begin
      OldHandle:=FItems.FHandle;
      FItems.FHandle := CreatePopupMenu;
      SendMessage(FWindowHandle, CM_MENUCHANGED, 0, 0);
        newHandle:=FItems.FHandle;
        if FItems.FHandle = 0 then raise EAHMMenuError.Create(ahmmnuoutofresources);
        FItems.PopulateMenu;
        TrackPopupMenu(FItems.FHandle, Flags[FAlignment] or TPM_RIGHTBUTTON,X,Y,0,FWindowhandle, nil);
        FItems.FHandle := OldHandle;
      while GetMenuItemCount(NewHandle)>0 do RemoveMenu(NewHandle,0,MF_BYPOSITION);
      DestroyMenu(NewHandle);
    end;
  end else TrackPopupMenu(FItems.FHandle, Flags[FAlignment] or TPM_RIGHTBUTTON,X,Y,0,FWindowhandle, nil);
end;

constructor TAHMFormMenu.Create(AOwner : TComponent);
begin
  inherited Create(AOwner);
  if not(csDesigning in Componentstate) and (AOwner is TWinControl) then
    FItems.FHandle:=GetSystemMenu(TWincontrol(AOwner).Handle,False);
end;


procedure TAHMFormMenu.Loaded;
begin
  inherited Loaded;
end;

Destructor TAHMFormMenu.Destroy;
begin
  inherited Destroy;
end;

constructor TAHMApplicationMenu.Create(AOwner : TComponent);
begin
  inherited Create(AOwner);
  if not(csDesigning in Componentstate) then
    FItems.Fhandle:=GetSystemMenu(Application.Handle,False);
end;

procedure TAHMApplicationMenu.Loaded;
begin
  inherited Loaded;
end;

Destructor TAHMApplicationMenu.Destroy;
begin
  inherited Destroy;
end;

initialization
  RegisterClasses([TAHMMenuItem]);
  AHMCommandPool := TBits.Create;
  AHMWorkTmp:=TBitmap.Create;
  AHMWorkInx:=nil;
finalization
  AHMWorkInx:=nil;
  AHMWorkTmp.Free;
  AHMCommandPool.Free;
end.
