home *** CD-ROM | disk | FTP | other *** search
/ Delphi Anthology / aDELPHI.iso / Runimage / Delphi50 / Source / Vcl / menus.pas < prev    next >
Pascal/Delphi Source File  |  1999-08-11  |  106KB  |  3,547 lines
  1.  
  2. {*******************************************************}
  3. {                                                       }
  4. {       Borland Delphi Visual Component Library         }
  5. {                                                       }
  6. {       Copyright (c) 1995,99 Inprise Corporation       }
  7. {                                                       }
  8. {*******************************************************}
  9.  
  10. unit Menus;
  11.  
  12. {$S-,W-,R-,T-,H+,X+}
  13. {$C PRELOAD}
  14.  
  15. interface
  16.  
  17. uses Windows, SysUtils, Classes, Contnrs, Messages, Graphics, ImgList, ActnList;
  18.  
  19. type
  20.   TMenuItem = class;
  21.  
  22.   EMenuError = class(Exception);
  23.   TMenu = class;
  24.   TMenuBreak = (mbNone, mbBreak, mbBarBreak);
  25.   TMenuChangeEvent = procedure (Sender: TObject; Source: TMenuItem; Rebuild: Boolean) of object;
  26.   TMenuDrawItemEvent = procedure (Sender: TObject; ACanvas: TCanvas;
  27.     ARect: TRect; Selected: Boolean) of object;
  28.   TAdvancedMenuDrawItemEvent = procedure (Sender: TObject; ACanvas: TCanvas;
  29.     ARect: TRect; State: TOwnerDrawState) of object;
  30.   TMenuMeasureItemEvent = procedure (Sender: TObject; ACanvas: TCanvas;
  31.     var Width, Height: Integer) of object;
  32.   TMenuItemAutoFlag = (maAutomatic, maManual, maParent);
  33.   TMenuAutoFlag = maAutomatic..maManual;
  34.  
  35. { TMenuActionLink }
  36.  
  37.   TMenuActionLink = class(TActionLink)
  38.   protected
  39.     FClient: TMenuItem;
  40.     procedure AssignClient(AClient: TObject); override;
  41.     function IsCaptionLinked: Boolean; override;
  42.     function IsCheckedLinked: Boolean; override;
  43.     function IsEnabledLinked: Boolean; override;
  44.     function IsHelpContextLinked: Boolean; override;
  45.     function IsHintLinked: Boolean; override;
  46.     function IsImageIndexLinked: Boolean; override;
  47.     function IsShortCutLinked: Boolean; override;
  48.     function IsVisibleLinked: Boolean; override;
  49.     function IsOnExecuteLinked: Boolean; override;
  50.     procedure SetCaption(const Value: string); override;
  51.     procedure SetChecked(Value: Boolean); override;
  52.     procedure SetEnabled(Value: Boolean); override;
  53.     procedure SetHelpContext(Value: THelpContext); override;
  54.     procedure SetHint(const Value: string); override;
  55.     procedure SetImageIndex(Value: Integer); override;
  56.     procedure SetShortCut(Value: TShortCut); override;
  57.     procedure SetVisible(Value: Boolean); override;
  58.     procedure SetOnExecute(Value: TNotifyEvent); override;
  59.   end;
  60.  
  61.   TMenuActionLinkClass = class of TMenuActionLink;
  62.  
  63. { TMenuItem }
  64.  
  65.   TMenuItem = class(TComponent)
  66.   private
  67.     FCaption: string;
  68.     FHandle: HMENU;
  69.     FChecked: Boolean;
  70.     FEnabled: Boolean;
  71.     FDefault: Boolean;
  72.     FAutoHotkeys: TMenuItemAutoFlag;
  73.     FAutoLineReduction: TMenuItemAutoFlag;
  74.     FRadioItem: Boolean;
  75.     FVisible: Boolean;
  76.     FGroupIndex: Byte;
  77.     FImageIndex: TImageIndex;
  78.     FActionLink: TMenuActionLink;
  79.     FBreak: TMenuBreak;
  80.     FBitmap: TBitmap;
  81.     FCommand: Word;
  82.     FHelpContext: THelpContext;
  83.     FHint: string;
  84.     FItems: TList;
  85.     FShortCut: TShortCut;
  86.     FParent: TMenuItem;
  87.     FMerged: TMenuItem;
  88.     FMergedWith: TMenuItem;
  89.     FMenu: TMenu;
  90.     FStreamedRebuild: Boolean;
  91.     FImageChangeLink: TChangeLink;
  92.     FSubMenuImages: TCustomImageList;
  93.     FOnChange: TMenuChangeEvent;
  94.     FOnClick: TNotifyEvent;
  95.     FOnDrawItem: TMenuDrawItemEvent;
  96.     FOnAdvancedDrawItem: TAdvancedMenuDrawItemEvent;
  97.     FOnMeasureItem: TMenuMeasureItemEvent;
  98.     procedure AppendTo(Menu: HMENU; ARightToLeft: Boolean);
  99.     procedure DoActionChange(Sender: TObject);
  100.     procedure ReadShortCutText(Reader: TReader);
  101.     procedure MergeWith(Menu: TMenuItem);
  102.     procedure RebuildHandle;
  103.     procedure PopulateMenu;
  104.     procedure SubItemChanged(Sender: TObject; Source: TMenuItem; Rebuild: Boolean);
  105.     procedure TurnSiblingsOff;
  106.     procedure VerifyGroupIndex(Position: Integer; Value: Byte);
  107.     function GetAction: TBasicAction;
  108.     function GetBitmap: TBitmap;
  109.     procedure SetAction(Value: TBasicAction);
  110.     procedure SetBitmap(Value: TBitmap);
  111.     procedure SetSubMenuImages(Value: TCustomImageList);
  112.     procedure ImageListChange(Sender: TObject);
  113.     procedure InitiateActions;
  114.     function IsCaptionStored: Boolean;
  115.     function IsCheckedStored: Boolean;
  116.     function IsEnabledStored: Boolean;
  117.     function IsHelpContextStored: Boolean;
  118.     function IsHintStored: Boolean;
  119.     function IsImageIndexStored: Boolean;
  120.     function IsOnClickStored: Boolean;
  121.     function IsShortCutStored: Boolean;
  122.     function IsVisibleStored: Boolean;
  123.     function InternalRethinkHotkeys(ForceRethink: Boolean): Boolean;
  124.     procedure SetAutoHotkeys(const Value: TMenuItemAutoFlag);
  125.     function InternalRethinkLines(ForceRethink: Boolean): Boolean;
  126.     procedure SetAutoLineReduction(const Value: TMenuItemAutoFlag);
  127.   protected
  128.     procedure ActionChange(Sender: TObject; CheckDefaults: Boolean); dynamic;
  129.     procedure AdvancedDrawItem(ACanvas: TCanvas; ARect: TRect;
  130.       State: TOwnerDrawState; TopLevel: Boolean); virtual;
  131.     procedure AssignTo(Dest: TPersistent); override;
  132.     procedure DefineProperties(Filer: TFiler); override;
  133.     procedure DoDrawText(ACanvas: TCanvas; const ACaption: string;
  134.       var Rect: TRect; Selected: Boolean; Flags: Longint);
  135.     procedure DrawItem(ACanvas: TCanvas; ARect: TRect; Selected: Boolean); virtual;
  136.     function GetActionLinkClass: TMenuActionLinkClass; dynamic;
  137.     function GetHandle: HMENU;
  138.     function GetCount: Integer;
  139.     procedure GetChildren(Proc: TGetChildProc; Root: TComponent); override;
  140.     function GetItem(Index: Integer): TMenuItem;
  141.     function GetMenuIndex: Integer;
  142.     function GetAutoHotkeys: Boolean;
  143.     function GetAutoLineReduction: Boolean;
  144.     function InsertNewLine(ABefore: Boolean; AItem: TMenuItem): Integer;
  145.     procedure MeasureItem(ACanvas: TCanvas; var Width, Height: Integer);
  146.     procedure MenuChanged(Rebuild: Boolean); virtual;
  147.     procedure Loaded; override;
  148.     procedure Notification(AComponent: TComponent;
  149.       Operation: TOperation); override;
  150.     procedure SetBreak(Value: TMenuBreak);
  151.     procedure SetCaption(const Value: string);
  152.     procedure SetChecked(Value: Boolean);
  153.     procedure SetChildOrder(Child: TComponent; Order: Integer); override;
  154.     procedure SetDefault(Value: Boolean);
  155.     procedure SetEnabled(Value: Boolean);
  156.     procedure SetGroupIndex(Value: Byte);
  157.     procedure SetImageIndex(Value: TImageIndex);
  158.     procedure SetMenuIndex(Value: Integer);
  159.     procedure SetParentComponent(Value: TComponent); override;
  160.     procedure SetRadioItem(Value: Boolean);
  161.     procedure SetShortCut(Value: TShortCut);
  162.     procedure SetVisible(Value: Boolean);
  163.     procedure UpdateItems;
  164.     property ActionLink: TMenuActionLink read FActionLink write FActionLink;
  165.   public
  166.     constructor Create(AOwner: TComponent); override;
  167.     destructor Destroy; override;
  168.     procedure InitiateAction; virtual;
  169.     procedure Insert(Index: Integer; Item: TMenuItem);
  170.     procedure Delete(Index: Integer);
  171.     procedure Clear;
  172.     procedure Click; virtual;
  173.     function Find(ACaption: string): TMenuItem;
  174.     function IndexOf(Item: TMenuItem): Integer;
  175.     function IsLine: Boolean;
  176.     function GetImageList: TCustomImageList;
  177.     function GetParentComponent: TComponent; override;
  178.     function GetParentMenu: TMenu;
  179.     function HasParent: Boolean; override;
  180.     function NewTopLine: Integer;
  181.     function NewBottomLine: Integer;
  182.     function InsertNewLineBefore(AItem: TMenuItem): Integer;
  183.     function InsertNewLineAfter(AItem: TMenuItem): Integer;
  184.     procedure Add(Item: TMenuItem); overload;
  185.     procedure Add(const AItems: array of TMenuItem); overload;
  186.     procedure Remove(Item: TMenuItem);
  187.     function RethinkHotkeys: Boolean;
  188.     function RethinkLines: Boolean;
  189.     property Command: Word read FCommand;
  190.     property Handle: HMENU read GetHandle;
  191.     property Count: Integer read GetCount;
  192.     property Items[Index: Integer]: TMenuItem read GetItem; default;
  193.     property MenuIndex: Integer read GetMenuIndex write SetMenuIndex;
  194.     property Parent: TMenuItem read FParent;
  195.   published
  196.     property Action: TBasicAction read GetAction write SetAction;
  197.     property AutoHotkeys: TMenuItemAutoFlag read FAutoHotkeys write SetAutoHotkeys default maParent;
  198.     property AutoLineReduction: TMenuItemAutoFlag read FAutoLineReduction write SetAutoLineReduction default maParent;
  199.     property Bitmap: TBitmap read GetBitmap write SetBitmap;
  200.     property Break: TMenuBreak read FBreak write SetBreak default mbNone;
  201.     property Caption: string read FCaption write SetCaption stored IsCaptionStored;
  202.     property Checked: Boolean read FChecked write SetChecked stored IsCheckedStored default False;
  203.     property SubMenuImages: TCustomImageList read FSubMenuImages write SetSubMenuImages;
  204.     property Default: Boolean read FDefault write SetDefault default False;
  205.     property Enabled: Boolean read FEnabled write SetEnabled stored IsEnabledStored default True;
  206.     property GroupIndex: Byte read FGroupIndex write SetGroupIndex default 0;
  207.     property HelpContext: THelpContext read FHelpContext write FHelpContext stored IsHelpContextStored default 0;
  208.     property Hint: string read FHint write FHint stored IsHintStored;
  209.     property ImageIndex: TImageIndex read FImageIndex write SetImageIndex stored IsImageIndexStored default -1;
  210.     property RadioItem: Boolean read FRadioItem write SetRadioItem default False;
  211.     property ShortCut: TShortCut read FShortCut write SetShortCut stored IsShortCutStored default 0;
  212.     property Visible: Boolean read FVisible write SetVisible stored IsVisibleStored default True;
  213.     property OnClick: TNotifyEvent read FOnClick write FOnClick stored IsOnClickStored;
  214.     property OnDrawItem: TMenuDrawItemEvent read FOnDrawItem write FOnDrawItem;
  215.     property OnAdvancedDrawItem: TAdvancedMenuDrawItemEvent read FOnAdvancedDrawItem write FOnAdvancedDrawItem;
  216.     property OnMeasureItem: TMenuMeasureItemEvent read FOnMeasureItem write FOnMeasureItem;
  217.   end;
  218.  
  219.   TFindItemKind = (fkCommand, fkHandle, fkShortCut);
  220.  
  221.   TMenu = class(TComponent)
  222.   private
  223.     FBiDiMode: TBiDiMode;
  224.     FItems: TMenuItem;
  225.     FWindowHandle: HWND;
  226.     FMenuImage: string;
  227.     FOwnerDraw: Boolean;
  228.     FParentBiDiMode: Boolean;
  229.     FImageChangeLink: TChangeLink;
  230.     FImages: TCustomImageList;
  231.     FOnChange: TMenuChangeEvent;
  232.     procedure SetBiDiMode(Value: TBiDiMode);
  233.     procedure SetOwnerDraw(Value: Boolean);
  234.     procedure SetImages(Value: TCustomImageList);
  235.     procedure SetParentBiDiMode(Value: Boolean);
  236.     procedure SetWindowHandle(Value: HWND);
  237.     procedure ImageListChange(Sender: TObject);
  238.     function IsBiDiModeStored: Boolean;
  239.     function UpdateImage: Boolean;
  240.     function GetAutoHotkeys: TMenuAutoFlag;
  241.     procedure SetAutoHotkeys(const Value: TMenuAutoFlag);
  242.     function GetAutoLineReduction: TMenuAutoFlag;
  243.     procedure SetAutoLineReduction(const Value: TMenuAutoFlag);
  244.   protected
  245.     procedure AdjustBiDiBehavior;
  246.     procedure DoChange(Source: TMenuItem; Rebuild: Boolean); virtual;
  247.     procedure DoBiDiModeChanged;
  248.     function DoGetMenuString(Menu: HMENU; ItemID: UINT; Str: PChar;
  249.       MaxCount: Integer; Flag: UINT): Integer;
  250.     procedure GetChildren(Proc: TGetChildProc; Root: TComponent); override;
  251.     function GetHandle: HMENU; virtual;
  252.     function IsOwnerDraw: Boolean;
  253.     procedure Loaded; override;
  254.     procedure MenuChanged(Sender: TObject; Source: TMenuItem; Rebuild: Boolean); virtual;
  255.     procedure Notification(AComponent: TComponent; Operation: TOperation); override;
  256.     procedure SetChildOrder(Child: TComponent; Order: Integer); override;
  257.     procedure UpdateItems;
  258.     property OnChange: TMenuChangeEvent read FOnChange write FOnChange;
  259.   public
  260.     constructor Create(AOwner: TComponent); override;
  261.     destructor Destroy; override;
  262.     function DispatchCommand(ACommand: Word): Boolean;
  263.     function DispatchPopup(AHandle: HMENU): Boolean;
  264.     function FindItem(Value: Integer; Kind: TFindItemKind): TMenuItem;
  265.     function GetHelpContext(Value: Integer; ByCommand: Boolean): THelpContext;
  266.     property Images: TCustomImageList read FImages write SetImages;
  267.     function IsRightToLeft: Boolean;
  268.     function IsShortCut(var Message: TWMKey): Boolean; dynamic;
  269.     procedure ParentBiDiModeChanged; overload;
  270.     procedure ParentBiDiModeChanged(AControl: TObject); overload;
  271.     procedure ProcessMenuChar(var Message: TWMMenuChar);
  272.     property AutoHotkeys: TMenuAutoFlag read GetAutoHotkeys write SetAutoHotkeys default maAutomatic;
  273.     property AutoLineReduction: TMenuAutoFlag read GetAutoLineReduction write SetAutoLineReduction default maAutomatic;
  274.     property BiDiMode: TBiDiMode read FBiDiMode write SetBiDiMode stored IsBiDiModeStored;
  275.     property Handle: HMENU read GetHandle;
  276.     property OwnerDraw: Boolean read FOwnerDraw write SetOwnerDraw default False;
  277.     property ParentBiDiMode: Boolean read FParentBiDiMode write SetParentBiDiMode default True;
  278.     property WindowHandle: HWND read FWindowHandle write SetWindowHandle;
  279.   published
  280.     property Items: TMenuItem read FItems;
  281.   end;
  282.  
  283.   TMainMenu = class(TMenu)
  284.   private
  285.     FOle2Menu: HMENU;
  286.     FAutoMerge: Boolean;
  287.     procedure ItemChanged;
  288.     procedure SetAutoMerge(Value: Boolean);
  289.   protected
  290.     procedure MenuChanged(Sender: TObject; Source: TMenuItem; Rebuild: Boolean); override;
  291.     function GetHandle: HMENU; override;
  292.   public
  293.     procedure Merge(Menu: TMainMenu);
  294.     procedure Unmerge(Menu: TMainMenu);
  295.     procedure PopulateOle2Menu(SharedMenu: HMenu; Groups: array of Integer;
  296.       var Widths: array of Longint);
  297.     procedure GetOle2AcceleratorTable(var AccelTable: HAccel;
  298.       var AccelCount: Integer; Groups: array of Integer);
  299.     procedure SetOle2MenuHandle(Handle: HMENU);
  300.   published
  301.     property AutoHotkeys;
  302.     property AutoLineReduction;
  303.     property AutoMerge: Boolean read FAutoMerge write SetAutoMerge default False;
  304.     property BiDiMode;
  305.     property Images;
  306.     property OwnerDraw;
  307.     property ParentBiDiMode;
  308.     property OnChange;
  309.   end;
  310.  
  311.   TPopupAlignment = (paLeft, paRight, paCenter);
  312.   TTrackButton = (tbRightButton, tbLeftButton);
  313.   TMenuAnimations = (maLeftToRight, maRightToLeft, maTopToBottom, maBottomToTop, maNone);
  314.   TMenuAnimation = set of TMenuAnimations;
  315.  
  316.   TPopupMenu = class(TMenu)
  317.   private
  318.     FPopupPoint: TPoint;
  319.     FAlignment: TPopupAlignment;
  320.     FAutoPopup: Boolean;
  321.     FPopupComponent: TComponent;
  322.     FTrackButton: TTrackButton;
  323.     FMenuAnimation: TMenuAnimation;
  324.     FOnPopup: TNotifyEvent;
  325.     function GetHelpContext: THelpContext;
  326.     procedure SetHelpContext(Value: THelpContext);
  327.     procedure SetBiDiModeFromPopupControl;
  328.   protected
  329.     function UseRightToLeftAlignment: Boolean;
  330.     procedure DoPopup(Sender: TObject); virtual;
  331.     property PopupPoint: TPoint read FPopupPoint;
  332.   public
  333.     constructor Create(AOwner: TComponent); override;
  334.     destructor Destroy; override;
  335.     procedure Popup(X, Y: Integer); virtual;
  336.     property PopupComponent: TComponent read FPopupComponent write FPopupComponent;
  337.   published
  338.     property Alignment: TPopupAlignment read FAlignment write FAlignment default paLeft;
  339.     property AutoHotkeys;
  340.     property AutoLineReduction;
  341.     property AutoPopup: Boolean read FAutoPopup write FAutoPopup default True;
  342.     property BiDiMode;
  343.     property HelpContext: THelpContext read GetHelpContext write SetHelpContext default 0;
  344.     property Images;
  345.     property MenuAnimation: TMenuAnimation read FMenuAnimation write FMenuAnimation default [];
  346.     property OwnerDraw;
  347.     property ParentBiDiMode;
  348.     property TrackButton: TTrackButton read FTrackButton write FTrackButton default tbRightButton;
  349.     property OnChange;
  350.     property OnPopup: TNotifyEvent read FOnPopup write FOnPopup;
  351.   end;
  352.  
  353.   TPopupList = class(TList)
  354.   protected
  355.     FWindow: HWND;
  356.     procedure MainWndProc(var Message: TMessage);
  357.     procedure WndProc(var Message: TMessage); virtual;
  358.   public
  359.     property Window: HWND read FWindow;
  360.     procedure Add(Popup: TPopupMenu);
  361.     procedure Remove(Popup: TPopupMenu);
  362.   end;
  363.  
  364.   PMenuItem = ^TMenuItem;
  365.  
  366.   TMenuItemStack = class(TStack)
  367.   public
  368.     procedure ClearItem(AItem: TMenuItem);
  369.   end;
  370.  
  371. var
  372.   PopupList: TPopupList;
  373.   ShortCutItems: TMenuItemStack;
  374.  
  375. function ShortCut(Key: Word; Shift: TShiftState): TShortCut;
  376. procedure ShortCutToKey(ShortCut: TShortCut; var Key: Word; var Shift: TShiftState);
  377. function ShortCutToText(ShortCut: TShortCut): string;
  378. function TextToShortCut(Text: string): TShortCut;
  379.  
  380. function NewMenu(Owner: TComponent; const AName: string; Items: array of TMenuItem): TMainMenu;
  381. function NewPopupMenu(Owner: TComponent; const AName: string;
  382.   Alignment: TPopupAlignment; AutoPopup: Boolean; Items: array of TMenuitem): TPopupMenu;
  383. function NewSubMenu(const ACaption: string; hCtx: Word;
  384.   const AName: string; Items: array of TMenuItem; AEnabled: Boolean = True): TMenuItem;
  385. function NewItem(const ACaption: string; AShortCut: TShortCut;
  386.   AChecked, AEnabled: Boolean; AOnClick: TNotifyEvent; hCtx: Word;
  387.   const AName: string): TMenuItem;
  388. function NewLine: TMenuItem;
  389.  
  390. procedure DrawMenuItem(MenuItem: TMenuItem; ACanvas: TCanvas; ARect: TRect;
  391.   State: TOwnerDrawState);
  392.  
  393. var
  394.   { These are the hotkeys that the auto-hotkey system will pick from.
  395.     Change this global variable at runtime if you want to add or remove
  396.     characters from the available characters.  Notice that by default we
  397.     do not do international characters. }
  398.   ValidMenuHotkeys: string = '1234567890ABCDEFGHIJKLMNOPQRSTUVWXYZ'; { do not localize }
  399.  
  400. const
  401.   cHotkeyPrefix = '&';
  402.   cLineCaption = '-';
  403.   cDialogSuffix = '...';
  404.  
  405. { StripHotkey removes the & escape char that marks the hotkey character(s) in
  406.   the string.  When the current locale is a Far East locale, this function also
  407.   looks for and removes parens around the hotkey, common in Far East locales. }
  408. function StripHotkey(const Text: string): string;
  409.  
  410. { GetHotkey will return the last hotkey that StripHotkey would strip. }
  411. function GetHotkey(const Text: string): string;
  412.  
  413. { Similar to AnsiSameText but strips hotkeys before comparing }
  414. function AnsiSameCaption(const Text1, Text2: string): Boolean;
  415.  
  416. implementation
  417.  
  418. uses Controls, Forms, Consts;
  419.  
  420. const
  421.   RightToLeftMenuFlag = MFT_RIGHTORDER or MFT_RIGHTJUSTIFY;
  422.   cMenuAutoFlagToItem: array [TMenuAutoFlag] of TMenuItemAutoFlag = (maAutomatic, maManual);
  423.   cItemAutoFlagToMenu: array [TMenuItemAutoFlag] of TMenuAutoFlag = (maAutomatic, maManual, maAutomatic);
  424.   cBooleanToItemAutoFlag: array [Boolean] of TMenuItemAutoFlag = (maManual, maAutomatic);
  425.   cItemAutoFlagToBoolean: array [TMenuItemAutoFlag] of Boolean = (True, False, True);
  426.  
  427. function FindPopupControl(const Pos: TPoint): TControl;
  428. var
  429.   Window: TWinControl;
  430. begin
  431.   Result := nil;
  432.   Window := FindVCLWindow(Pos);
  433.   if Window <> nil then
  434.   begin
  435.     Result := Window.ControlAtPos(Pos, False);
  436.     if Result = nil then Result := Window;
  437.   end;
  438. end;
  439.  
  440. procedure Error(ResStr: PResStringRec);
  441.  
  442.   function ReturnAddr: Pointer;
  443.   asm
  444.           MOV     EAX,[EBP+4]
  445.   end;
  446.  
  447. begin
  448.   raise EMenuError.CreateRes(ResStr) at ReturnAddr;
  449. end;
  450.  
  451. { TShortCut processing routines }
  452.  
  453. function ShortCut(Key: Word; Shift: TShiftState): TShortCut;
  454. begin
  455.   Result := 0;
  456.   if WordRec(Key).Hi <> 0 then Exit;
  457.   Result := Key;
  458.   if ssShift in Shift then Inc(Result, scShift);
  459.   if ssCtrl in Shift then Inc(Result, scCtrl);
  460.   if ssAlt in Shift then Inc(Result, scAlt);
  461. end;
  462.  
  463. procedure ShortCutToKey(ShortCut: TShortCut; var Key: Word; var Shift: TShiftState);
  464. begin
  465.   Key := ShortCut and not (scShift + scCtrl + scAlt);
  466.   Shift := [];
  467.   if ShortCut and scShift <> 0 then Include(Shift, ssShift);
  468.   if ShortCut and scCtrl <> 0 then Include(Shift, ssCtrl);
  469.   if ShortCut and scAlt <> 0 then Include(Shift, ssAlt);
  470. end;
  471.  
  472. type
  473.   TMenuKeyCap = (mkcBkSp, mkcTab, mkcEsc, mkcEnter, mkcSpace, mkcPgUp,
  474.     mkcPgDn, mkcEnd, mkcHome, mkcLeft, mkcUp, mkcRight, mkcDown, mkcIns,
  475.     mkcDel, mkcShift, mkcCtrl, mkcAlt);
  476.  
  477. var
  478.   MenuKeyCaps: array[TMenuKeyCap] of string = (
  479.     SmkcBkSp, SmkcTab, SmkcEsc, SmkcEnter, SmkcSpace, SmkcPgUp,
  480.     SmkcPgDn, SmkcEnd, SmkcHome, SmkcLeft, SmkcUp, SmkcRight,
  481.     SmkcDown, SmkcIns, SmkcDel, SmkcShift, SmkcCtrl, SmkcAlt);
  482.  
  483. function GetSpecialName(ShortCut: TShortCut): string;
  484. var
  485.   ScanCode: Integer;
  486.   KeyName: array[0..255] of Char;
  487. begin
  488.   Result := '';
  489.   ScanCode := MapVirtualKey(WordRec(ShortCut).Lo, 0) shl 16;
  490.   if ScanCode <> 0 then
  491.   begin
  492.     GetKeyNameText(ScanCode, KeyName, SizeOf(KeyName));
  493.     GetSpecialName := KeyName;
  494.   end;
  495. end;
  496.  
  497. function ShortCutToText(ShortCut: TShortCut): string;
  498. var
  499.   Name: string;
  500. begin
  501.   case WordRec(ShortCut).Lo of
  502.     $08, $09:
  503.       Name := MenuKeyCaps[TMenuKeyCap(Ord(mkcBkSp) + WordRec(ShortCut).Lo - $08)];
  504.     $0D: Name := MenuKeyCaps[mkcEnter];
  505.     $1B: Name := MenuKeyCaps[mkcEsc];
  506.     $20..$28:
  507.       Name := MenuKeyCaps[TMenuKeyCap(Ord(mkcSpace) + WordRec(ShortCut).Lo - $20)];
  508.     $2D..$2E:
  509.       Name := MenuKeyCaps[TMenuKeyCap(Ord(mkcIns) + WordRec(ShortCut).Lo - $2D)];
  510.     $30..$39: Name := Chr(WordRec(ShortCut).Lo - $30 + Ord('0'));
  511.     $41..$5A: Name := Chr(WordRec(ShortCut).Lo - $41 + Ord('A'));
  512.     $60..$69: Name := Chr(WordRec(ShortCut).Lo - $60 + Ord('0'));
  513.     $70..$87: Name := 'F' + IntToStr(WordRec(ShortCut).Lo - $6F);
  514.   else
  515.     Name := GetSpecialName(ShortCut);
  516.   end;
  517.   if Name <> '' then
  518.   begin
  519.     Result := '';
  520.     if ShortCut and scShift <> 0 then Result := Result + MenuKeyCaps[mkcShift];
  521.     if ShortCut and scCtrl <> 0 then Result := Result + MenuKeyCaps[mkcCtrl];
  522.     if ShortCut and scAlt <> 0 then Result := Result + MenuKeyCaps[mkcAlt];
  523.     Result := Result + Name;
  524.   end
  525.   else Result := '';
  526. end;
  527.  
  528. { This function is *very* slow.  Use sparingly.  Return 0 if no VK code was
  529.   found for the text }
  530.  
  531. function TextToShortCut(Text: string): TShortCut;
  532.  
  533.   { If the front of Text is equal to Front then remove the matching piece
  534.     from Text and return True, otherwise return False }
  535.  
  536.   function CompareFront(var Text: string; const Front: string): Boolean;
  537.   begin
  538.     Result := False;
  539.     if (Length(Text) >= Length(Front)) and
  540.       (AnsiStrLIComp(PChar(Text), PChar(Front), Length(Front)) = 0) then
  541.     begin
  542.       Result := True;
  543.       Delete(Text, 1, Length(Front));
  544.     end;
  545.   end;
  546.  
  547. var
  548.   Key: TShortCut;
  549.   Shift: TShortCut;
  550. begin
  551.   Result := 0;
  552.   Shift := 0;
  553.   while True do
  554.   begin
  555.     if CompareFront(Text, MenuKeyCaps[mkcShift]) then Shift := Shift or scShift
  556.     else if CompareFront(Text, '^') then Shift := Shift or scCtrl
  557.     else if CompareFront(Text, MenuKeyCaps[mkcCtrl]) then Shift := Shift or scCtrl
  558.     else if CompareFront(Text, MenuKeyCaps[mkcAlt]) then Shift := Shift or scAlt
  559.     else Break;
  560.   end;
  561.   if Text = '' then Exit;
  562.   for Key := $08 to $255 do { Copy range from table in ShortCutToText }
  563.     if AnsiCompareText(Text, ShortCutToText(Key)) = 0 then
  564.     begin
  565.       Result := Key or Shift;
  566.       Exit;
  567.     end;
  568. end;
  569.  
  570. { Menu command managment }
  571.  
  572. var
  573.   CommandPool: TBits;
  574.  
  575. function UniqueCommand: Word;
  576. begin
  577.   Result := CommandPool.OpenBit;
  578.   CommandPool[Result] := True;
  579. end;
  580.  
  581. { Used to populate or merge menus }
  582.  
  583. procedure IterateMenus(Func: Pointer; Menu1, Menu2: TMenuItem);
  584. var
  585.   I, J: Integer;
  586.   IIndex, JIndex: Byte;
  587.   Menu1Size, Menu2Size: Integer;
  588.   Done: Boolean;
  589.  
  590.   function Iterate(var I: Integer; MenuItem: TMenuItem; AFunc: Pointer): Boolean;
  591.   var
  592.     Item: TMenuItem;
  593.   begin
  594.     if MenuItem = nil then Exit;
  595.     Result := False;
  596.     while not Result and (I < MenuItem.Count) do
  597.     begin
  598.       Item := MenuItem[I];
  599.       if Item.GroupIndex > IIndex then Break;
  600.       asm
  601.                 MOV     EAX,Item
  602.                 MOV     EDX,[EBP+8]
  603.                 PUSH    DWORD PTR [EDX]
  604.                 CALL    DWORD PTR AFunc
  605.                 ADD     ESP,4
  606.                 MOV     Result,AL
  607.       end;
  608.       Inc(I);
  609.     end;
  610.   end;
  611.  
  612. begin
  613.   I := 0;
  614.   J := 0;
  615.   Menu1Size := 0;
  616.   Menu2Size := 0;
  617.   if Menu1 <> nil then Menu1Size := Menu1.Count;
  618.   if Menu2 <> nil then Menu2Size := Menu2.Count;
  619.   Done := False;
  620.   while not Done and ((I < Menu1Size) or (J < Menu2Size)) do
  621.   begin
  622.     IIndex := High(Byte);
  623.     JIndex := High(Byte);
  624.     if (I < Menu1Size) then IIndex := Menu1[I].GroupIndex;
  625.     if (J < Menu2Size) then JIndex := Menu2[J].GroupIndex;
  626.     if IIndex <= JIndex then Done := Iterate(I, Menu1, Func)
  627.     else
  628.     begin
  629.       IIndex := JIndex;
  630.       Done := Iterate(J, Menu2, Func);
  631.     end;
  632.     while (I < Menu1Size) and (Menu1[I].GroupIndex <= IIndex) do Inc(I);
  633.     while (J < Menu2Size) and (Menu2[J].GroupIndex <= IIndex) do Inc(J);
  634.   end;
  635. end;
  636.  
  637. { TMenuActionLink }
  638.  
  639. procedure TMenuActionLink.AssignClient(AClient: TObject);
  640. begin
  641.   FClient := AClient as TMenuItem;
  642. end;
  643.  
  644. function TMenuActionLink.IsCaptionLinked: Boolean;
  645. begin
  646.   Result := inherited IsCaptionLinked and
  647.             AnsiSameCaption(FClient.Caption, (Action as TCustomAction).Caption);
  648. end;
  649.  
  650. function TMenuActionLink.IsCheckedLinked: Boolean;
  651. begin
  652.   Result := inherited IsCheckedLinked and
  653.     (FClient.Checked = (Action as TCustomAction).Checked);
  654. end;
  655.  
  656. function TMenuActionLink.IsEnabledLinked: Boolean;
  657. begin
  658.   Result := inherited IsEnabledLinked and
  659.     (FClient.Enabled = (Action as TCustomAction).Enabled);
  660. end;
  661.  
  662. function TMenuActionLink.IsHelpContextLinked: Boolean;
  663. begin
  664.   Result := inherited IsHelpContextLinked and
  665.     (FClient.HelpContext = (Action as TCustomAction).HelpContext);
  666. end;
  667.  
  668. function TMenuActionLink.IsHintLinked: Boolean;
  669. begin
  670.   Result := inherited IsHintLinked and
  671.     (FClient.Hint = (Action as TCustomAction).Hint);
  672. end;
  673.  
  674. function TMenuActionLink.IsImageIndexLinked: Boolean;
  675. begin
  676.   Result := inherited IsImageIndexLinked and
  677.     (FClient.ImageIndex = (Action as TCustomAction).ImageIndex);
  678. end;
  679.  
  680. function TMenuActionLink.IsShortCutLinked: Boolean;
  681. begin
  682.   Result := inherited IsShortCutLinked and
  683.     (FClient.ShortCut = (Action as TCustomAction).ShortCut);
  684. end;
  685.  
  686. function TMenuActionLink.IsVisibleLinked: Boolean;
  687. begin
  688.   Result := inherited IsVisibleLinked and
  689.     (FClient.Visible = (Action as TCustomAction).Visible);
  690. end;
  691.  
  692. function TMenuActionLink.IsOnExecuteLinked: Boolean;
  693. begin
  694.   Result := inherited IsOnExecuteLinked and
  695.     (@FClient.OnClick = @Action.OnExecute);
  696. end;
  697.  
  698. procedure TMenuActionLink.SetCaption(const Value: string);
  699. begin
  700.   if IsCaptionLinked then FClient.Caption := Value;
  701. end;
  702.  
  703. procedure TMenuActionLink.SetChecked(Value: Boolean);
  704. begin
  705.   if IsCheckedLinked then FClient.Checked := Value;
  706. end;
  707.  
  708. procedure TMenuActionLink.SetEnabled(Value: Boolean);
  709. begin
  710.   if IsEnabledLinked then FClient.Enabled := Value;
  711. end;
  712.  
  713. procedure TMenuActionLink.SetHelpContext(Value: THelpContext);
  714. begin
  715.   if IsHelpContextLinked then FClient.HelpContext := Value;
  716. end;
  717.  
  718. procedure TMenuActionLink.SetHint(const Value: string);
  719. begin
  720.   if IsHintLinked then FClient.Hint := Value;
  721. end;
  722.  
  723. procedure TMenuActionLink.SetImageIndex(Value: Integer);
  724. begin
  725.   if IsImageIndexLinked then FClient.ImageIndex := Value;
  726. end;
  727.  
  728. procedure TMenuActionLink.SetShortCut(Value: TShortCut);
  729. begin
  730.   if IsShortCutLinked then FClient.ShortCut := Value;
  731. end;
  732.  
  733. procedure TMenuActionLink.SetVisible(Value: Boolean);
  734. begin
  735.   if IsVisibleLinked then FClient.Visible := Value;
  736. end;
  737.  
  738. procedure TMenuActionLink.SetOnExecute(Value: TNotifyEvent);
  739. begin
  740.   if IsOnExecuteLinked then FClient.OnClick := Value;
  741. end;
  742.  
  743. { TMenuItem }
  744.  
  745. constructor TMenuItem.Create(AOwner: TComponent);
  746. begin
  747.   inherited Create(AOwner);
  748.   FVisible := True;
  749.   FEnabled := True;
  750.   FAutoHotkeys := maParent;
  751.   FAutoLineReduction := maParent;
  752.   FCommand := UniqueCommand;
  753.   FImageIndex := -1;
  754.   FImageChangeLink := TChangeLink.Create;
  755.   FImageChangeLink.OnChange := ImageListChange;
  756. end;
  757.  
  758. destructor TMenuItem.Destroy;
  759. begin
  760.   ShortCutItems.ClearItem(Self);
  761.   if FParent <> nil then
  762.   begin
  763.     FParent.Remove(Self);
  764.     FParent := nil;
  765.   end;
  766.   while Count > 0 do Items[0].Free;
  767.   if FHandle <> 0 then
  768.   begin
  769.     MergeWith(nil);
  770.     DestroyMenu(FHandle);
  771.   end;
  772.   FItems.Free;
  773.   FreeAndNil(FActionLink);
  774.   FreeAndNil(FImageChangeLink);
  775.   if FCommand <> 0 then CommandPool[FCommand] := False;
  776.   if Assigned(FBitmap) then FBitmap.Free;
  777.   inherited Destroy;
  778. end;
  779.  
  780. const
  781.   Checks: array[Boolean] of DWORD = (MF_UNCHECKED, MF_CHECKED);
  782.   Enables: array[Boolean] of DWORD = (MF_DISABLED or MF_GRAYED, MF_ENABLED);
  783.   Breaks: array[TMenuBreak] of DWORD = (0, MF_MENUBREAK, MF_MENUBARBREAK);
  784.   Separators: array[Boolean] of DWORD = (MF_STRING, MF_SEPARATOR);
  785.  
  786. procedure TMenuItem.AppendTo(Menu: HMENU; ARightToLeft: Boolean);
  787. const
  788.   IBreaks: array[TMenuBreak] of DWORD = (MFT_STRING, MFT_MENUBREAK, MFT_MENUBARBREAK);
  789.   IChecks: array[Boolean] of DWORD = (MFS_UNCHECKED, MFS_CHECKED);
  790.   IDefaults: array[Boolean] of DWORD = (0, MFS_DEFAULT);
  791.   IEnables: array[Boolean] of DWORD = (MFS_DISABLED or MFS_GRAYED, MFS_ENABLED);
  792.   IRadios: array[Boolean] of DWORD = (MFT_STRING, MFT_RADIOCHECK);
  793.   ISeparators: array[Boolean] of DWORD = (MFT_STRING, MFT_SEPARATOR);
  794.   IRTL: array[Boolean] of DWORD = (0, RightToLeftMenuFlag);
  795.   IOwnerDraw: array[Boolean] of DWORD = (MFT_STRING, MFT_OWNERDRAW);
  796. var
  797.   MenuItemInfo: TMenuItemInfo;
  798.   Caption: string;
  799.   NewFlags: Integer;
  800.   IsOwnerDraw: Boolean;
  801.   ParentMenu: TMenu;
  802. begin
  803.   if FVisible then
  804.   begin
  805.     Caption := FCaption;
  806.     if GetCount > 0 then MenuItemInfo.hSubMenu := GetHandle
  807.     else if (FShortCut <> scNone) and ((Parent = nil) or
  808.       (Parent.Parent <> nil) or not (Parent.Owner is TMainMenu)) then
  809.       Caption := Caption + #9 + ShortCutToText(FShortCut);
  810.     if Lo(GetVersion) >= 4 then
  811.     begin
  812.       MenuItemInfo.cbSize := 44; // Required for Windows 95
  813.       MenuItemInfo.fMask := MIIM_CHECKMARKS or MIIM_DATA or MIIM_ID or
  814.         MIIM_STATE or MIIM_SUBMENU or MIIM_TYPE;
  815.       ParentMenu := GetParentMenu;
  816. //      IsOwnerDraw := Assigned(ParentMenu) and ParentMenu.IsOwnerDraw or
  817.       IsOwnerDraw := Assigned(ParentMenu) and
  818.                      (ParentMenu.OwnerDraw or (GetImageList <> nil)) or
  819.                      Assigned(FBitmap) and not FBitmap.Empty;
  820.       MenuItemInfo.fType := IRadios[FRadioItem] or IBreaks[FBreak] or
  821.         ISeparators[FCaption = cLineCaption] or IRTL[ARightToLeft] or
  822.         IOwnerDraw[IsOwnerDraw];
  823.       MenuItemInfo.fState := IChecks[FChecked] or IEnables[FEnabled]
  824.         or IDefaults[FDefault];
  825.       MenuItemInfo.wID := Command;
  826.       MenuItemInfo.hSubMenu := 0;
  827.       MenuItemInfo.hbmpChecked := 0;
  828.       MenuItemInfo.hbmpUnchecked := 0;
  829.       MenuItemInfo.dwTypeData := PChar(Caption);
  830.       if GetCount > 0 then MenuItemInfo.hSubMenu := GetHandle;
  831.       InsertMenuItem(Menu, DWORD(-1), True, MenuItemInfo);
  832.     end
  833.     else
  834.     begin
  835.       NewFlags := Breaks[FBreak] or Checks[FChecked] or Enables[FEnabled] or
  836.         Separators[FCaption = cLineCaption] or MF_BYPOSITION;
  837.       if GetCount > 0 then
  838.         InsertMenu(Menu, DWORD(-1), MF_POPUP or NewFlags, GetHandle,
  839.           PChar(FCaption))
  840.       else
  841.         InsertMenu(Menu, DWORD(-1), NewFlags, Command, PChar(Caption));
  842.     end;
  843.   end;
  844. end;
  845.  
  846. procedure TMenuItem.PopulateMenu;
  847. var
  848.   MenuRightToLeft: Boolean;
  849.  
  850.   function AddIn(MenuItem: TMenuItem): Boolean;
  851.   begin
  852.     MenuItem.AppendTo(FHandle, MenuRightToLeft);
  853.     Result := False;
  854.   end;
  855.  
  856. begin
  857.   if (FMenu <> nil) and
  858.      (FMenu is TMainMenu) then
  859.   begin
  860.     InternalRethinkHotkeys(False);
  861.     InternalRethinkLines(False);
  862.   end;
  863.  
  864.   // all menu items use BiDiMode of their root menu
  865.   MenuRightToLeft := (FMenu <> nil) and FMenu.IsRightToLeft;
  866.   IterateMenus(@AddIn, FMerged, Self);
  867. end;
  868.  
  869. procedure TMenuItem.ReadShortCutText(Reader: TReader);
  870. begin
  871.   ShortCut := TextToShortCut(Reader.ReadString);
  872. end;
  873.  
  874. procedure TMenuItem.MergeWith(Menu: TMenuItem);
  875. begin
  876.   if FMerged <> Menu then
  877.   begin
  878.     if FMerged <> nil then FMerged.FMergedWith := nil;
  879.     FMerged := Menu;
  880.     if FMerged <> nil then FMerged.FMergedWith := Self;
  881.     RebuildHandle;
  882.   end;
  883. end;
  884.  
  885. procedure TMenuItem.Loaded;
  886. begin
  887.   inherited Loaded;
  888.   if Action <> nil then ActionChange(Action, True);
  889.   if FStreamedRebuild then RebuildHandle;
  890. end;
  891.  
  892. procedure TMenuItem.RebuildHandle;
  893. begin
  894.   if csDestroying in ComponentState then Exit;
  895.   if csReading in ComponentState then
  896.     FStreamedRebuild := True
  897.   else
  898.   begin
  899.     if FMergedWith <> nil then
  900.       FMergedWith.RebuildHandle
  901.     else
  902.     begin
  903.       while GetMenuItemCount(Handle) > 0 do
  904.         RemoveMenu(Handle, 0, MF_BYPOSITION);
  905.       if (FParent = nil) and (FMenu is TMainMenu) then
  906.       //if (Owner = nil) or (Owner is TMainMenu) then
  907.       begin
  908.         DestroyMenu(FHandle);
  909.         FHandle := 0;
  910.       end
  911.       else
  912.         PopulateMenu;
  913.       MenuChanged(False);
  914.     end;
  915.   end;
  916. end;
  917.  
  918. procedure TMenuItem.VerifyGroupIndex(Position: Integer; Value: Byte);
  919. var
  920.   I: Integer;
  921. begin
  922.   for I := 0 to GetCount - 1 do
  923.     if I < Position then
  924.     begin
  925.       if Items[I].GroupIndex > Value then Error(@SGroupIndexTooLow)
  926.     end
  927.     else
  928.       { Ripple change to menu items at Position and after }
  929.       if Items[I].GroupIndex < Value then Items[I].FGroupIndex := Value;
  930. end;
  931.  
  932. function TMenuItem.GetHandle: HMENU;
  933. begin
  934.   if FHandle = 0 then
  935.   begin
  936.     if Owner is TPopupMenu then
  937.       FHandle := CreatePopupMenu
  938.     else
  939.       FHandle := CreateMenu;
  940.     if FHandle = 0 then Error(@SOutOfResources);
  941.     PopulateMenu;
  942.   end;
  943.   Result := FHandle;
  944. end;
  945.  
  946. procedure TMenuItem.DefineProperties(Filer: TFiler);
  947. begin
  948.   inherited DefineProperties(Filer);
  949.   Filer.DefineProperty('ShortCutText', ReadShortCutText, nil, False);
  950. end;
  951.  
  952. procedure TMenuItem.DoDrawText(ACanvas: TCanvas; const ACaption: string;
  953.   var Rect: TRect; Selected: Boolean; Flags: Longint);
  954. var
  955.   Text: string;
  956.   R: TRect;
  957.   ParentMenu: TMenu;
  958. begin
  959.   ParentMenu := GetParentMenu;
  960.   if (ParentMenu <> nil) and (ParentMenu.IsRightToLeft) then
  961.   begin
  962.     if Flags and DT_LEFT = DT_LEFT then
  963.       Flags := Flags and (not DT_LEFT) or DT_RIGHT
  964.     else if Flags and DT_RIGHT = DT_RIGHT then
  965.       Flags := Flags and (not DT_RIGHT) or DT_LEFT;
  966.     Flags := Flags or DT_RTLREADING;
  967.   end;
  968.   Text := ACaption;
  969.   if (Flags and DT_CALCRECT <> 0) and ((Text = '') or
  970.     (Text[1] = cHotkeyPrefix) and (Text[2] = #0)) then Text := Text + ' ';
  971.   with ACanvas do
  972.   begin
  973.     if Text = cLineCaption then
  974.     begin
  975.       if Flags and DT_CALCRECT = 0 then
  976.       begin
  977.         R := Rect;
  978.         Inc(R.Top, 4);
  979.         DrawEdge(Handle, R, EDGE_ETCHED, BF_TOP);
  980.       end;
  981.     end
  982.     else
  983.     begin
  984.       Brush.Style := bsClear;
  985.       if Default then
  986.         Font.Style := Font.Style + [fsBold];
  987.       if not Enabled then
  988.       begin
  989.         if not Selected then
  990.         begin
  991.           OffsetRect(Rect, 1, 1);
  992.           Font.Color := clBtnHighlight;
  993.           DrawText(Handle, PChar(Text), Length(Text), Rect, Flags);
  994.           OffsetRect(Rect, -1, -1);
  995.         end;
  996.         if Selected and (ColorToRGB(clHighlight) = ColorToRGB(clBtnShadow)) then
  997.           Font.Color := clBtnHighlight else
  998.           Font.Color := clBtnShadow;
  999.       end;
  1000.       DrawText(Handle, PChar(Text), Length(Text), Rect, Flags);
  1001.     end;
  1002.   end;
  1003. end;
  1004.  
  1005. procedure TMenuItem.DrawItem(ACanvas: TCanvas; ARect: TRect; Selected: Boolean);
  1006. begin
  1007.   if Assigned(FOnDrawItem) then
  1008.     FOnDrawItem(Self, ACanvas, ARect, Selected);
  1009. end;
  1010.  
  1011. procedure TMenuItem.AdvancedDrawItem(ACanvas: TCanvas; ARect: TRect;
  1012.   State: TOwnerDrawState; TopLevel: Boolean);
  1013. const
  1014.   Alignments: array[TPopupAlignment] of Word = (DT_LEFT, DT_RIGHT, DT_CENTER);
  1015.   EdgeStyle: array[Boolean] of Longint = (BDR_RAISEDINNER, BDR_SUNKENOUTER);
  1016. var
  1017.   ImageList: TCustomImageList;
  1018.   ParentMenu: TMenu;
  1019.   Alignment: TPopupAlignment;
  1020.   DrawImage, DrawGlyph: Boolean;
  1021.   GlyphRect, SaveRect: TRect;
  1022.   DrawStyle: Longint;
  1023.   Glyph: TBitmap;
  1024.   OldBrushColor: TColor;
  1025.   Selected: Boolean;
  1026.   Win98Plus: Boolean;
  1027.   Win2K: Boolean;
  1028.  
  1029.   procedure NormalDraw;
  1030.   begin
  1031.     with ACanvas do
  1032.     begin
  1033.       //ImageList := GetImageList;
  1034.       if not Selected then FillRect(ARect);
  1035.       if ParentMenu is TMenu then
  1036.         Alignment := paLeft
  1037.       else if ParentMenu is TPopupMenu then
  1038.         Alignment := TPopupMenu(ParentMenu).Alignment
  1039.       else
  1040.         Alignment := paLeft;
  1041.       GlyphRect.Left := ARect.Left + 1;
  1042.       GlyphRect.Top := ARect.Top + 1;
  1043.       if Caption = cLineCaption then
  1044.       begin
  1045.         FillRect(ARect);
  1046.         GlyphRect.Left := 0;
  1047.         GlyphRect.Right := -4;
  1048.         DrawGlyph := False;
  1049.       end
  1050.       else
  1051.       begin
  1052.         DrawImage := (ImageList <> nil) and ((ImageIndex > -1) and
  1053.           (ImageIndex < ImageList.Count) or Checked and ((FBitmap = nil) or
  1054.           FBitmap.Empty));
  1055.         if DrawImage or Assigned(FBitmap) and not FBitmap.Empty then
  1056.         begin
  1057.           DrawGlyph := True;
  1058.  
  1059.           if DrawImage then
  1060.           begin
  1061.             GlyphRect.Right := GlyphRect.Left + ImageList.Width;
  1062.             GlyphRect.Bottom := GlyphRect.Top + ImageList.Height;
  1063.           end
  1064.           else
  1065.           begin
  1066.             { Need to add BitmapWidth/Height properties for TMenuItem if we're to
  1067.               support them.  Right now let's hardcode them to 16x16. }
  1068.             GlyphRect.Right := GlyphRect.Left + 16;
  1069.             GlyphRect.Bottom := GlyphRect.Top + 16;
  1070.           end;
  1071.  
  1072.           { Draw background pattern brush if selected }
  1073.           if Checked then
  1074.           begin
  1075.             Inc(GlyphRect.Right);
  1076.             Inc(GlyphRect.Bottom);
  1077.             OldBrushColor := Brush.Color;
  1078.             if not (odSelected in State) then
  1079.             begin
  1080.               OldBrushColor := Brush.Color;
  1081.               Brush.Bitmap := AllocPatternBitmap(clBtnFace, clBtnHighlight);
  1082.               FillRect(GlyphRect);
  1083.             end
  1084.             else
  1085.             begin
  1086.               Brush.Color := clBtnFace;
  1087.               FillRect(GlyphRect);
  1088.             end;
  1089.             Brush.Color := OldBrushColor;
  1090.             Inc(GlyphRect.Left);
  1091.             Inc(GlyphRect.Top);
  1092.           end;
  1093.  
  1094.           if DrawImage then
  1095.           begin
  1096.             if (ImageIndex > -1) and (ImageIndex < ImageList.Count) then
  1097.               ImageList.Draw(ACanvas, GlyphRect.Left, GlyphRect.Top, ImageIndex,
  1098.                 Enabled)
  1099.             else
  1100.             begin
  1101.               { Draw a menu check }
  1102.               Glyph := TBitmap.Create;
  1103.               try
  1104.                 Glyph.Transparent := True;
  1105.                 Glyph.Handle := LoadBitmap(0, PChar(OBM_CHECK));
  1106.                 OldBrushColor := Font.Color;
  1107.                 Font.Color := clBtnText;
  1108.                 Draw(GlyphRect.Left + (GlyphRect.Right - GlyphRect.Left - Glyph.Width) div 2 + 1,
  1109.                   GlyphRect.Top + (GlyphRect.Bottom - GlyphRect.Top - Glyph.Height) div 2 + 1, Glyph);
  1110.                 Font.Color := OldBrushColor;
  1111.               finally
  1112.                 Glyph.Free;
  1113.               end;
  1114.             end;
  1115.           end
  1116.           else
  1117.           begin
  1118.             SaveRect := GlyphRect;
  1119.             { Make sure image is within glyph bounds }
  1120.             if FBitmap.Width < GlyphRect.Right - GlyphRect.Left then
  1121.               with GlyphRect do
  1122.               begin
  1123.                 Left := Left + ((Right - Left) - FBitmap.Width) div 2 + 1;
  1124.                 Right := Left + FBitmap.Width;
  1125.               end;
  1126.             if FBitmap.Height < GlyphRect.Bottom - GlyphRect.Top then
  1127.               with GlyphRect do
  1128.               begin
  1129.                 Top := Top + ((Bottom - Top) - FBitmap.Height) div 2 + 1;
  1130.                 Bottom := Top + FBitmap.Height;
  1131.               end;
  1132.             StretchDraw(GlyphRect, FBitmap);
  1133.             GlyphRect := SaveRect;
  1134.           end;
  1135.  
  1136.           if Checked then
  1137.           begin
  1138.             Dec(GlyphRect.Right);
  1139.             Dec(GlyphRect.Bottom);
  1140.           end;
  1141.         end
  1142.         else
  1143.         begin
  1144.           if (ImageList <> nil) and not TopLevel then
  1145.           begin
  1146.             GlyphRect.Right := GlyphRect.Left + ImageList.Width;
  1147.             GlyphRect.Bottom := GlyphRect.Top + ImageList.Height;
  1148.           end
  1149.           else
  1150.           begin
  1151.             GlyphRect.Right := GlyphRect.Left;
  1152.             GlyphRect.Bottom := GlyphRect.Top;
  1153.           end;
  1154.           DrawGlyph := False;
  1155.         end;
  1156.       end;
  1157.       with GlyphRect do
  1158.       begin
  1159.         Dec(Left);
  1160.         Dec(Top);
  1161.         Inc(Right, 2);
  1162.         Inc(Bottom, 2);
  1163.       end;
  1164.  
  1165.       if Checked or Selected and DrawGlyph then
  1166.         DrawEdge(Handle, GlyphRect, EdgeStyle[Checked], BF_RECT);
  1167.  
  1168.       if Selected then
  1169.       begin
  1170.         if DrawGlyph then ARect.Left := GlyphRect.Right + 1;
  1171.         if not (Win98Plus and TopLevel) then
  1172.           Brush.Color := clHighlight;
  1173.         FillRect(ARect);
  1174.       end;
  1175.       if TopLevel and Win98Plus then
  1176.       begin
  1177.         if Selected then
  1178.           DrawEdge(Handle, ARect, BDR_SUNKENOUTER, BF_RECT)
  1179.         else if odHotLight in State then
  1180.           DrawEdge(Handle, ARect, BDR_RAISEDINNER, BF_RECT);
  1181.         if not Selected then
  1182.           OffsetRect(ARect, 0, -1);
  1183.       end;
  1184.       if not (Selected and DrawGlyph) then
  1185.         ARect.Left := GlyphRect.Right + 1;
  1186.       Inc(ARect.Left, 2);
  1187.       Dec(ARect.Right, 1);
  1188.  
  1189.       DrawStyle := DT_EXPANDTABS or DT_SINGLELINE or Alignments[Alignment];
  1190.       if Win2K and (odNoAccel in State) then
  1191.         DrawStyle := DrawStyle or DT_HIDEPREFIX;
  1192.       { Calculate vertical layout }
  1193.       SaveRect := ARect;
  1194.       if odDefault in State then
  1195.         Font.Style := [fsBold];
  1196.       DoDrawText(ACanvas, Caption, ARect, Selected, DrawStyle or DT_CALCRECT or DT_NOCLIP);
  1197.       OffsetRect(ARect, 0, ((SaveRect.Bottom - SaveRect.Top) - (ARect.Bottom - ARect.Top)) div 2);
  1198.       if TopLevel and Selected and Win98Plus then
  1199.         OffsetRect(ARect, 1, 0);
  1200.       DoDrawText(ACanvas, Caption, ARect, Selected, DrawStyle);
  1201.       if (ShortCut <> 0) and not TopLevel then
  1202.       begin
  1203.         ARect.Left := ARect.Right;
  1204.         ARect.Right := SaveRect.Right - 10;
  1205.         DoDrawText(ACanvas, ShortCutToText(ShortCut), ARect, Selected, DT_RIGHT);
  1206.       end;
  1207.     end;
  1208.   end;
  1209.  
  1210.   procedure BiDiDraw;
  1211.   var
  1212.     S: string;
  1213.   begin
  1214.     with ACanvas do
  1215.     begin
  1216.       //ImageList := GetImageList;
  1217.       if not Selected then FillRect(ARect);
  1218.       if ParentMenu is TMenu then
  1219.         Alignment := paLeft
  1220.       else if ParentMenu is TPopupMenu then
  1221.         Alignment := TPopupMenu(ParentMenu).    Alignment
  1222.       else
  1223.         Alignment := paLeft;    
  1224.       GlyphRect.Right := ARect.Right - 1;
  1225.       GlyphRect.Top := ARect.Top + 1;
  1226.       if Caption = cLineCaption then
  1227.       begin
  1228.         FillRect(ARect);
  1229.         GlyphRect.Left := GlyphRect.Right + 2;
  1230.         GlyphRect.Right := 0;
  1231.         DrawGlyph := False;
  1232.       end
  1233.       else
  1234.       begin
  1235.         DrawImage := (ImageList <> nil) and ((ImageIndex > -1) and
  1236.           (ImageIndex < ImageList.    Count) or Checked and ((FBitmap = nil) or
  1237.           FBitmap.    Empty));    
  1238.         if DrawImage or Assigned(FBitmap) and not FBitmap.    Empty then
  1239.         begin
  1240.           DrawGlyph := True;    
  1241.     
  1242.           if DrawImage then
  1243.           begin
  1244.             GlyphRect.Left := GlyphRect.Right - ImageList.Width;
  1245.             GlyphRect.Bottom := GlyphRect.Top + ImageList.Height;
  1246.           end
  1247.           else
  1248.           begin
  1249.             { Need to add BitmapWidth/Height properties for TMenuItem if we're to
  1250.               support them.  Right now let's hardcode them to 16x16. }
  1251.             GlyphRect.Left := GlyphRect.Right - 16;
  1252.             GlyphRect.Bottom := GlyphRect.Top + 16;
  1253.           end;    
  1254.     
  1255.           { Draw background pattern brush if selected }
  1256.           if Checked then
  1257.           begin
  1258.             Dec(GlyphRect.Left);
  1259.             Inc(GlyphRect.Bottom);
  1260.             OldBrushColor := Brush.Color;
  1261.             if not Selected then
  1262.             begin
  1263.               OldBrushColor := Brush.Color;
  1264.               Brush.Bitmap := AllocPatternBitmap(clBtnFace, clBtnHighlight);
  1265.               FillRect(GlyphRect);
  1266.             end
  1267.             else
  1268.             begin
  1269.               Brush.Color := clBtnFace;
  1270.               FillRect(GlyphRect);
  1271.             end;
  1272.             Brush.Color := OldBrushColor;
  1273.             Dec(GlyphRect.Right);
  1274.             Inc(GlyphRect.Top);
  1275.           end;
  1276.     
  1277.           if DrawImage then
  1278.           begin
  1279.             if (ImageIndex > -1) and (ImageIndex < ImageList.Count) then
  1280.               ImageList.Draw(ACanvas, GlyphRect.Left, GlyphRect.Top, ImageIndex,
  1281.                 Enabled)
  1282.             else
  1283.             begin
  1284.               { Draw a menu check }
  1285.               Glyph := TBitmap.Create;
  1286.               try
  1287.                 Glyph.Transparent := True;
  1288.                 Glyph.Handle := LoadBitmap(0, PChar(OBM_CHECK));
  1289.                 OldBrushColor := Font.Color;
  1290.                 Font.Color := clBtnText;
  1291.                 Draw(GlyphRect.Left + (GlyphRect.Right - GlyphRect.Left - Glyph.Width) div 2 + 1,
  1292.                   GlyphRect.Top + (GlyphRect.Bottom - GlyphRect.Top - Glyph.Height) div 2 + 1, Glyph);
  1293.                 Font.Color := OldBrushColor;
  1294.               finally
  1295.                 Glyph.Free;
  1296.               end;
  1297.             end;
  1298.           end
  1299.           else
  1300.           begin
  1301.             SaveRect := GlyphRect;
  1302.             { Make sure image is within glyph bounds }
  1303.             if FBitmap.Width < GlyphRect.Right - GlyphRect.Left then
  1304.               with GlyphRect do
  1305.               begin
  1306.                 Right := Right - ((Right - Left) - FBitmap.Width) div 2 + 1;
  1307.                 Left := Right - FBitmap.Width;
  1308.               end;
  1309.             if FBitmap.Height < GlyphRect.Bottom - GlyphRect.Top then
  1310.               with GlyphRect do
  1311.               begin
  1312.                 Top := Top + ((Bottom - Top) - FBitmap.Height) div 2 + 1;
  1313.                 Bottom := Top + FBitmap.Height;
  1314.               end;
  1315.             StretchDraw(GlyphRect, FBitmap);
  1316.             GlyphRect := SaveRect;
  1317.           end;
  1318.     
  1319.           if Checked then
  1320.           begin
  1321.             Dec(GlyphRect.Right);    
  1322.             Dec(GlyphRect.Bottom);    
  1323.           end;    
  1324.         end
  1325.         else
  1326.         begin
  1327.           if (ImageList <> nil) and not TopLevel then
  1328.           begin
  1329.             GlyphRect.Left := GlyphRect.Right - ImageList.Width;
  1330.             GlyphRect.Bottom := GlyphRect.Top + ImageList.Height;
  1331.           end
  1332.           else
  1333.           begin
  1334.             GlyphRect.Left := GlyphRect.Right;
  1335.             GlyphRect.Bottom := GlyphRect.Top;
  1336.           end;
  1337.           DrawGlyph := False;
  1338.         end;    
  1339.       end;    
  1340.       with GlyphRect do
  1341.       begin
  1342.         Dec(Left);    
  1343.         Dec(Top);    
  1344.         Inc(Right, 2);    
  1345.         Inc(Bottom, 2);    
  1346.       end;    
  1347.     
  1348.       if Checked or Selected and DrawGlyph then
  1349.         DrawEdge(Handle, GlyphRect, EdgeStyle[Checked], BF_RECT);    
  1350.     
  1351.       if Selected then
  1352.       begin
  1353.         if DrawGlyph then ARect.Right := GlyphRect.Left - 1;
  1354.         if not (Win98Plus and TopLevel) then
  1355.           Brush.Color := clHighlight;    
  1356.         FillRect(ARect);    
  1357.       end;    
  1358.       if TopLevel and Win98Plus then
  1359.       begin
  1360.         if Selected then
  1361.           DrawEdge(Handle, ARect, BDR_SUNKENOUTER, BF_RECT)
  1362.         else if odHotLight in State then
  1363.           DrawEdge(Handle, ARect, BDR_RAISEDINNER, BF_RECT);
  1364.         if not Selected then
  1365.           OffsetRect(ARect, 0, -1);
  1366.       end;
  1367.       if not (Selected and DrawGlyph) then
  1368.         ARect.Right := GlyphRect.Left - 1;
  1369.       Inc(ARect.Left, 2);    
  1370.       Dec(ARect.Right, 1);    
  1371.     
  1372.       DrawStyle := DT_EXPANDTABS or DT_SINGLELINE or Alignments[Alignment];    
  1373.       if Win2K and (odNoAccel in State) then
  1374.         DrawStyle := DrawStyle or DT_HIDEPREFIX;
  1375.       { Calculate vertical layout }
  1376.       SaveRect := ARect;    
  1377.       if odDefault in State then
  1378.         Font.Style := [fsBold];
  1379.       DoDrawText(ACanvas, Caption, ARect, Selected, DrawStyle or DT_CALCRECT or DT_NOCLIP);    
  1380.       { the DT_CALCRECT does not take into account alignment }
  1381.       ARect.Left := SaveRect.Left;
  1382.       ARect.Right := SaveRect.Right;
  1383.       OffsetRect(ARect, 0, ((SaveRect.Bottom - SaveRect.Top) - (ARect.Bottom - ARect.Top)) div 2);    
  1384.       if TopLevel and Selected and Win98Plus then
  1385.         OffsetRect(ARect, 1, 0);
  1386.       DoDrawText(ACanvas, Caption, ARect, Selected, DrawStyle);    
  1387.       if (ShortCut <> 0) and not TopLevel then
  1388.       begin
  1389.         S := ShortCutToText(ShortCut);
  1390.         ARect.Left := 10;
  1391.         ARect.Right := ARect.Left + ACanvas.TextWidth(S);
  1392.         DoDrawText(ACanvas, S, ARect, Selected, DT_RIGHT);
  1393.       end;
  1394.     end;    
  1395.   end;
  1396.  
  1397. begin
  1398.   ParentMenu := GetParentMenu;
  1399.   ImageList := GetImageList;
  1400.   Selected := odSelected in State;
  1401.   Win98Plus := (Win32MajorVersion > 4) or
  1402.     ((Win32MajorVersion = 4) and (Win32MinorVersion > 0));
  1403.   Win2K := (Win32MajorVersion > 4) and (Win32Platform = VER_PLATFORM_WIN32_NT);
  1404.   if (ParentMenu <> nil) and (ParentMenu.OwnerDraw or (ImageList <> nil)) and
  1405.     (Assigned(FOnAdvancedDrawItem) or Assigned(FOnDrawItem)) then
  1406.   begin
  1407.     DrawItem(ACanvas, ARect, Selected);
  1408.     if Assigned(FOnAdvancedDrawItem) then
  1409.       FOnAdvancedDrawItem(Self, ACanvas, ARect, State);
  1410.   end else
  1411.     if (ParentMenu <> nil) and (not ParentMenu.IsRightToLeft) then
  1412.       NormalDraw
  1413.     else
  1414.       BiDiDraw;
  1415. end;
  1416.  
  1417. function TMenuItem.GetImageList: TCustomImageList;
  1418. var
  1419.   vItem: TMenuItem;
  1420.   vMenu: TMenu;
  1421. begin
  1422.   Result := nil;
  1423.   vItem := Parent;
  1424.   while (vItem <> nil) and (vItem.SubMenuImages = nil) do
  1425.     vItem := vItem.Parent;
  1426.   if vItem <> nil then
  1427.     Result := vItem.SubMenuImages
  1428.   else
  1429.   begin
  1430.     vMenu := GetParentMenu;
  1431.     if vMenu <> nil then
  1432.       Result := vMenu.Images;
  1433.   end;
  1434. end;
  1435.  
  1436. procedure TMenuItem.MeasureItem(ACanvas: TCanvas; var Width, Height: Integer);
  1437. const
  1438.   Alignments: array[TPopupAlignment] of Word = (DT_LEFT, DT_RIGHT, DT_CENTER);
  1439. var
  1440.   Alignment: TPopupAlignment;
  1441.   ImageList: TCustomImageList;
  1442.   ParentMenu: TMenu;
  1443.   DrawGlyph: Boolean;
  1444.   TopLevel: Boolean;
  1445.   DrawStyle: Integer;
  1446.   Text: string;
  1447.   R: TRect;
  1448.  
  1449.   procedure GetMenuSize;
  1450.   var
  1451.     NonClientMetrics: TNonClientMetrics;
  1452.   begin
  1453.     NonClientMetrics.cbSize := sizeof(NonClientMetrics);
  1454.     if SystemParametersInfo(SPI_GETNONCLIENTMETRICS, 0, @NonClientMetrics, 0) then
  1455.     begin
  1456.       Width := NonClientMetrics.iMenuWidth;
  1457.       Height := NonClientMetrics.iMenuHeight;
  1458.     end;
  1459.   end;
  1460.  
  1461. begin
  1462.   if GetParentComponent is TMainMenu then
  1463.   begin
  1464.     TopLevel := True;
  1465.     GetMenuSize;
  1466.   end
  1467.   else TopLevel := False;
  1468.   ParentMenu := GetParentMenu;
  1469.   ImageList := GetImageList;
  1470.   if Caption = cLineCaption then
  1471.   begin
  1472.     Height := 5;
  1473.     Width := -2;
  1474.     DrawGlyph := False;
  1475.   end
  1476.   else if Assigned(ImageList) and ((ImageIndex > -1) or not TopLevel) then
  1477.   begin
  1478.     Width := ImageList.Width;
  1479.     if not TopLevel then
  1480.       Height := ImageList.Height;
  1481.     DrawGlyph := True;
  1482.   end
  1483.   else if Assigned(FBitmap) and not FBitmap.Empty then
  1484.   begin
  1485.     Width := 16;
  1486.     if not TopLevel then
  1487.       Height := 16;
  1488.     DrawGlyph := True;
  1489.   end
  1490.   else
  1491.   begin
  1492.     Width := -7;
  1493.     DrawGlyph := False;
  1494.   end;
  1495.   if DrawGlyph and not TopLevel then
  1496.     Inc(Width, 15);
  1497.   if not TopLevel then
  1498.     Inc(Height, 3);
  1499.   FillChar(R, SizeOf(R), 0);
  1500.   if ParentMenu is TMenu then
  1501.     Alignment := paLeft
  1502.   else if ParentMenu is TPopupMenu then
  1503.     Alignment := TPopupMenu(ParentMenu).Alignment
  1504.   else
  1505.     Alignment := paLeft;
  1506.   if ShortCut <> 0 then
  1507.     Text := Concat(Caption, ShortCutToText(ShortCut)) else
  1508.     Text := Caption;
  1509.   DrawStyle := Alignments[Alignment] or DT_EXPANDTABS or DT_SINGLELINE or
  1510.     DT_NOCLIP or DT_CALCRECT;
  1511.   DoDrawText(ACanvas, Text, R, False, DrawStyle);
  1512.   Inc(Width, R.Right - R.Left + 7);
  1513.   if Assigned(FOnMeasureItem) then FOnMeasureItem(Self, ACanvas, Width, Height);
  1514. end;
  1515.  
  1516. function TMenuItem.HasParent: Boolean;
  1517. begin
  1518.   Result := True;
  1519. end;
  1520.  
  1521. procedure TMenuItem.SetBreak(Value: TMenuBreak);
  1522. begin
  1523.   if FBreak <> Value then
  1524.   begin
  1525.     FBreak := Value;
  1526.     MenuChanged(True);
  1527.   end;
  1528. end;
  1529.  
  1530. procedure TMenuItem.SetCaption(const Value: string);
  1531. begin
  1532.   if FCaption <> Value then
  1533.   begin
  1534.     FCaption := Value;
  1535.     MenuChanged(True);
  1536.   end;
  1537. end;
  1538.  
  1539. procedure TMenuItem.TurnSiblingsOff;
  1540. var
  1541.   I: Integer;
  1542.   Item: TMenuItem;
  1543. begin
  1544.   if FParent <> nil then
  1545.     for I := 0 to FParent.Count - 1 do
  1546.     begin
  1547.       Item := FParent[I];
  1548.       if (Item <> Self) and Item.FRadioItem and (Item.GroupIndex = GroupIndex) then
  1549.         Item.SetChecked(False);
  1550.     end;
  1551. end;
  1552.  
  1553. procedure TMenuItem.SetChecked(Value: Boolean);
  1554. begin
  1555.   if FChecked <> Value then
  1556.   begin
  1557.     FChecked := Value;
  1558.     if (FParent <> nil) and not (csReading in ComponentState) then
  1559.       CheckMenuItem(FParent.Handle, FCommand, MF_BYCOMMAND or Checks[Value]);
  1560.     if Value and FRadioItem then
  1561.       TurnSiblingsOff;
  1562.   end;
  1563. end;
  1564.  
  1565. procedure TMenuItem.SetEnabled(Value: Boolean);
  1566. begin
  1567.   if FEnabled <> Value then
  1568.   begin
  1569.     FEnabled := Value;
  1570.     if ((Win32Platform = VER_PLATFORM_WIN32_NT) and (Count <> 0)) or
  1571.       ((Parent <> nil) and Assigned(Parent.FMergedWith)) then
  1572.       MenuChanged(True)
  1573.     else
  1574.     begin
  1575.       if (FParent <> nil) and not (csReading in ComponentState) then
  1576.         EnableMenuItem(FParent.Handle, FCommand, MF_BYCOMMAND or Enables[Value]);
  1577.       MenuChanged(False);
  1578.     end;
  1579.   end;
  1580. end;
  1581.  
  1582. procedure TMenuItem.SetGroupIndex(Value: Byte);
  1583. begin
  1584.   if FGroupIndex <> Value then
  1585.   begin
  1586.     if Parent <> nil then Parent.VerifyGroupIndex(Parent.IndexOf(Self), Value);
  1587.     FGroupIndex := Value;
  1588.     if FChecked and FRadioItem then
  1589.       TurnSiblingsOff;
  1590.   end;
  1591. end;
  1592.  
  1593. function TMenuItem.GetAction: TBasicAction;
  1594. begin
  1595.   if FActionLink <> nil then
  1596.     Result := FActionLink.Action else
  1597.     Result := nil;
  1598. end;
  1599.  
  1600. function TMenuItem.GetActionLinkClass: TMenuActionLinkClass;
  1601. begin
  1602.   Result := TMenuActionLink;
  1603. end;
  1604.  
  1605. function TMenuItem.GetCount: Integer;
  1606. begin
  1607.   if FItems = nil then Result := 0
  1608.   else Result := FItems.Count;
  1609. end;
  1610.  
  1611. function TMenuItem.GetItem(Index: Integer): TMenuItem;
  1612. begin
  1613.   if FItems = nil then Error(@SMenuIndexError);
  1614.   Result := FItems[Index];
  1615. end;
  1616.  
  1617. procedure TMenuItem.SetShortCut(Value: TShortCut);
  1618. begin
  1619.   if FShortCut <> Value then
  1620.   begin
  1621.     FShortCut := Value;
  1622.     MenuChanged(True);
  1623.   end;
  1624. end;
  1625.  
  1626. procedure TMenuItem.SetVisible(Value: Boolean);
  1627. begin
  1628.   if Value <> FVisible then
  1629.   begin
  1630.     FVisible := Value;
  1631.     MenuChanged(True);
  1632.   end;
  1633. end;
  1634.  
  1635. procedure TMenuItem.SetImageIndex(Value: TImageIndex);
  1636. begin
  1637.   if Value <> FImageIndex then
  1638.   begin
  1639.     FImageIndex := Value;
  1640.     MenuChanged(True);
  1641.   end;
  1642. end;
  1643.  
  1644. function TMenuItem.GetMenuIndex: Integer;
  1645. begin
  1646.   Result := -1;
  1647.   if FParent <> nil then Result := FParent.IndexOf(Self);
  1648. end;
  1649.  
  1650. procedure TMenuItem.SetMenuIndex(Value: Integer);
  1651. var
  1652.   Parent: TMenuItem;
  1653.   Count: Integer;
  1654. begin
  1655.   if FParent <> nil then
  1656.   begin
  1657.     Count := FParent.Count;
  1658.     if Value < 0 then Value := 0;
  1659.     if Value >= Count then Value := Count - 1;
  1660.     if Value <> MenuIndex then
  1661.     begin
  1662.       Parent := FParent;
  1663.       Parent.Remove(Self);
  1664.       Parent.Insert(Value, Self);
  1665.     end;
  1666.   end;
  1667. end;
  1668.  
  1669. procedure TMenuItem.GetChildren(Proc: TGetChildProc; Root: TComponent);
  1670. var
  1671.   I: Integer;
  1672. begin
  1673.   for I := 0 to Count - 1 do Proc(Items[I]);
  1674. end;
  1675.  
  1676. procedure TMenuItem.SetChildOrder(Child: TComponent; Order: Integer);
  1677. begin
  1678.   (Child as TMenuItem).MenuIndex := Order;
  1679. end;
  1680.  
  1681. procedure TMenuItem.SetDefault(Value: Boolean);
  1682. var
  1683.   I: Integer;
  1684. begin
  1685.   if FDefault <> Value then
  1686.   begin
  1687.     if Value and (FParent <> nil) then
  1688.       for I := 0 to FParent.Count - 1 do
  1689.         if FParent[I].Default then FParent[I].FDefault := False;
  1690.     FDefault := Value;
  1691.     MenuChanged(True);
  1692.   end;
  1693. end;
  1694.  
  1695. procedure TMenuItem.InitiateAction;
  1696. begin
  1697.   if FActionLink <> nil then FActionLink.Update;
  1698. end;
  1699.  
  1700. procedure TMenuItem.Insert(Index: Integer; Item: TMenuItem);
  1701. begin
  1702.   if Item.FParent <> nil then Error(@SMenuReinserted);
  1703.   if FItems = nil then FItems := TList.Create;
  1704.   if (Index - 1 >= 0) and (Index - 1 < FItems.Count) then
  1705.     if Item.GroupIndex < TMenuItem(FItems[Index - 1]).GroupIndex then
  1706.       Item.GroupIndex := TMenuItem(FItems[Index - 1]).GroupIndex;
  1707.   VerifyGroupIndex(Index, Item.GroupIndex);
  1708.   FItems.Insert(Index, Item);
  1709.   Item.FParent := Self;
  1710.   Item.FOnChange := SubItemChanged;
  1711.   if FHandle <> 0 then RebuildHandle;
  1712.   MenuChanged(Count = 1);
  1713. end;
  1714.  
  1715. procedure TMenuItem.Delete(Index: Integer);
  1716. var
  1717.   Cur: TMenuItem;
  1718. begin
  1719.   if (Index < 0) or (FItems = nil) or (Index >= GetCount) then Error(@SMenuIndexError);
  1720.   Cur := FItems[Index];
  1721.   FItems.Delete(Index);
  1722.   Cur.FParent := nil;
  1723.   Cur.FOnChange := nil;
  1724.   if FHandle <> 0 then RebuildHandle;
  1725.   MenuChanged(Count = 0);
  1726. end;
  1727.  
  1728. procedure TMenuItem.Click;
  1729. begin
  1730.   if Enabled then
  1731.   begin
  1732.     { Call OnClick if assigned and not equal to associated action's OnExecute.
  1733.       If associated action's OnExecute assigned then call it, otherwise, call
  1734.       OnClick. }
  1735.     if Assigned(FOnClick) and (Action <> nil) and (@FOnClick <> @Action.OnExecute) then
  1736.       FOnClick(Self)
  1737.     else if not (csDesigning in ComponentState) and (ActionLink <> nil) then
  1738.       FActionLink.Execute
  1739.     else if Assigned(FOnClick) then
  1740.       FOnClick(Self);
  1741.   end;
  1742. end;
  1743.  
  1744. function TMenuItem.IndexOf(Item: TMenuItem): Integer;
  1745. begin
  1746.   Result := -1;
  1747.   if FItems <> nil then Result := FItems.IndexOf(Item);
  1748. end;
  1749.  
  1750. procedure TMenuItem.Add(Item: TMenuItem);
  1751. begin
  1752.   Insert(GetCount, Item);
  1753. end;
  1754.  
  1755. procedure TMenuItem.Remove(Item: TMenuItem);
  1756. var
  1757.   I: Integer;
  1758. begin
  1759.   I := IndexOf(Item);
  1760.   if I = -1 then Error(@SMenuNotFound);
  1761.   Delete(I);
  1762. end;
  1763.  
  1764. procedure TMenuItem.MenuChanged(Rebuild: Boolean);
  1765. var
  1766.   Source: TMenuItem;
  1767. begin
  1768.   if (Parent = nil) and (Owner is TMenu) then
  1769.     Source := nil else
  1770.     Source := Self;
  1771.   if Assigned(FOnChange) then FOnChange(Self, Source, Rebuild);
  1772. end;
  1773.  
  1774. procedure TMenuItem.SubItemChanged(Sender: TObject; Source: TMenuItem; Rebuild: Boolean);
  1775. begin
  1776.   if Rebuild and ((FHandle <> 0) or Assigned(FMergedWith)) then RebuildHandle;
  1777.   if Parent <> nil then Parent.SubItemChanged(Self, Source, False)
  1778.   else if Owner is TMainMenu then TMainMenu(Owner).ItemChanged;
  1779. end;
  1780.  
  1781. function TMenuItem.GetBitmap: TBitmap;
  1782. begin
  1783.   if FBitmap = nil then FBitmap := TBitmap.Create;
  1784.   FBitmap.Transparent := True;
  1785.   Result := FBitmap;
  1786. end;
  1787.  
  1788. procedure TMenuItem.SetAction(Value: TBasicAction);
  1789. begin
  1790.   if Value = nil then
  1791.   begin
  1792.     FActionLink.Free;
  1793.     FActionLink := nil;
  1794.   end
  1795.   else
  1796.   begin
  1797.     if FActionLink = nil then
  1798.       FActionLink := GetActionLinkClass.Create(Self);
  1799.     FActionLink.Action := Value;
  1800.     FActionLink.OnChange := DoActionChange;
  1801.     ActionChange(Value, csLoading in Value.ComponentState);
  1802.     Value.FreeNotification(Self);
  1803.   end;
  1804. end;
  1805.  
  1806. procedure TMenuItem.SetBitmap(Value: TBitmap);
  1807. begin
  1808.   if FBitmap = nil then FBitmap := TBitmap.Create;
  1809.   FBitmap.Assign(Value);
  1810.   MenuChanged(True);
  1811. end;
  1812.  
  1813. procedure TMenuItem.InitiateActions;
  1814. var
  1815.   I: Integer;
  1816. begin
  1817.   for I := 0 to Count - 1 do
  1818.     Items[I].InitiateAction;
  1819. end;
  1820.  
  1821. function TMenuItem.GetParentComponent: TComponent;
  1822. begin
  1823.   if (FParent <> nil) and (FParent.FMenu <> nil) then
  1824.     Result := FParent.FMenu else
  1825.     Result := FParent;
  1826. end;
  1827.  
  1828. procedure TMenuItem.SetParentComponent(Value: TComponent);
  1829. begin
  1830.   if FParent <> nil then FParent.Remove(Self);
  1831.   if Value <> nil then
  1832.     if Value is TMenu then
  1833.       TMenu(Value).Items.Add(Self)
  1834.     else if Value is TMenuItem then
  1835.       TMenuItem(Value).Add(Self);
  1836. end;
  1837.  
  1838. function TMenuItem.GetParentMenu: TMenu;
  1839. var
  1840.   MenuItem: TMenuItem;
  1841. begin
  1842.   MenuItem := Self;
  1843.   while Assigned(MenuItem.FParent) do MenuItem := MenuItem.FParent;
  1844.   Result := MenuItem.FMenu
  1845. end;
  1846.  
  1847. procedure TMenuItem.SetRadioItem(Value: Boolean);
  1848. begin
  1849.   if FRadioItem <> Value then
  1850.   begin
  1851.     FRadioItem := Value;
  1852.     if FChecked and FRadioItem then
  1853.       TurnSiblingsOff;
  1854.     MenuChanged(True);
  1855.   end;
  1856. end;
  1857.  
  1858. procedure TMenuItem.ActionChange(Sender: TObject; CheckDefaults: Boolean);
  1859. begin
  1860.   if Action is TCustomAction then
  1861.     with TCustomAction(Sender) do
  1862.     begin
  1863.       if not CheckDefaults or (Self.Caption = '') then
  1864.         Self.Caption := Caption;
  1865.       if not CheckDefaults or (Self.Checked = False) then
  1866.         Self.Checked := Checked;
  1867.       if not CheckDefaults or (Self.Enabled = True) then
  1868.         Self.Enabled := Enabled;
  1869.       if not CheckDefaults or (Self.HelpContext = 0) then
  1870.         Self.HelpContext := HelpContext;
  1871.       if not CheckDefaults or (Self.Hint = '') then
  1872.         Self.Hint := Hint;
  1873.       if not CheckDefaults or (Self.ImageIndex = -1) then
  1874.         Self.ImageIndex := ImageIndex;
  1875.       if not CheckDefaults or (Self.ShortCut = scNone) then
  1876.         Self.ShortCut := ShortCut;
  1877.       if not CheckDefaults or (Self.Visible = True) then
  1878.         Self.Visible := Visible;
  1879.       if not CheckDefaults or not Assigned(Self.OnClick) then
  1880.         Self.OnClick := OnExecute;
  1881.     end;
  1882. end;
  1883.  
  1884. procedure TMenuItem.DoActionChange(Sender: TObject);
  1885. begin
  1886.   if Sender = Action then ActionChange(Sender, False);
  1887. end;
  1888.  
  1889. function TMenuItem.IsCaptionStored: Boolean;
  1890. begin
  1891.   Result := (ActionLink = nil) or not FActionLink.IsCaptionLinked;
  1892. end;
  1893.  
  1894. function TMenuItem.IsCheckedStored: Boolean;
  1895. begin
  1896.   Result := (ActionLink = nil) or not FActionLink.IsCheckedLinked;
  1897. end;
  1898.  
  1899. function TMenuItem.IsEnabledStored: Boolean;
  1900. begin
  1901.   Result := (ActionLink = nil) or not FActionLink.IsEnabledLinked;
  1902. end;
  1903.  
  1904. function TMenuItem.IsHintStored: Boolean;
  1905. begin
  1906.   Result := (ActionLink = nil) or not FActionLink.IsHintLinked;
  1907. end;
  1908.  
  1909. function TMenuItem.IsHelpContextStored: Boolean;
  1910. begin
  1911.   Result := (ActionLink = nil) or not FActionLink.IsHelpContextLinked;
  1912. end;
  1913.  
  1914. function TMenuItem.IsImageIndexStored: Boolean;
  1915. begin
  1916.   Result := (ActionLink = nil) or not FActionLink.IsImageIndexLinked;
  1917. end;
  1918.  
  1919. function TMenuItem.IsShortCutStored: Boolean;
  1920. begin
  1921.   Result := (ActionLink = nil) or not FActionLink.IsShortCutLinked;
  1922. end;
  1923.  
  1924. function TMenuItem.IsVisibleStored: Boolean;
  1925. begin
  1926.   Result := (ActionLink = nil) or not FActionLink.IsVisibleLinked;
  1927. end;
  1928.  
  1929. function TMenuItem.IsOnClickStored: Boolean;
  1930. begin
  1931.   Result := (ActionLink = nil) or not FActionLink.IsOnExecuteLinked;
  1932. end;
  1933.  
  1934. procedure TMenuItem.AssignTo(Dest: TPersistent);
  1935. begin
  1936.   if Dest is TCustomAction then
  1937.     with TCustomAction(Dest) do
  1938.     begin
  1939.       Enabled := Self.Enabled;
  1940.       HelpContext := Self.HelpContext;
  1941.       Hint := Self.Hint;
  1942.       ImageIndex := Self.ImageIndex;
  1943.       Caption := Self.Caption;
  1944.       Visible := Self.Visible;
  1945.       OnExecute := Self.OnClick;
  1946.     end
  1947.   else inherited AssignTo(Dest);
  1948. end;
  1949.  
  1950. procedure TMenuItem.Notification(AComponent: TComponent;
  1951.   Operation: TOperation);
  1952. begin
  1953.   inherited Notification(AComponent, Operation);
  1954.   if (Operation = opRemove) and (AComponent = Action) then Action := nil;
  1955. end;
  1956.  
  1957. procedure TMenuItem.SetSubMenuImages(Value: TCustomImageList);
  1958. begin
  1959.   if FSubMenuImages <> nil then FSubMenuImages.UnRegisterChanges(FImageChangeLink);
  1960.   FSubMenuImages := Value;
  1961.   if FSubMenuImages <> nil then
  1962.   begin
  1963.     FSubMenuImages.RegisterChanges(FImageChangeLink);
  1964.     FSubMenuImages.FreeNotification(Self);
  1965.   end;
  1966.   UpdateItems;
  1967. end;
  1968.  
  1969. procedure TMenuItem.ImageListChange(Sender: TObject);
  1970. begin
  1971.   if Sender = SubMenuImages then UpdateItems;
  1972. end;
  1973.  
  1974. procedure TMenuItem.UpdateItems;
  1975.  
  1976.   function UpdateItem(MenuItem: TMenuItem): Boolean;
  1977.   begin
  1978.     Result := False;
  1979.     IterateMenus(@UpdateItem, MenuItem.FMerged, MenuItem);
  1980.     MenuItem.SubItemChanged(MenuItem, MenuItem, True);
  1981.   end;
  1982.  
  1983. begin
  1984.   IterateMenus(@UpdateItem, FMerged, Self);
  1985. end;
  1986.  
  1987. procedure TMenuItem.Add(const AItems: array of TMenuItem);
  1988. var
  1989.   I: Integer;
  1990. begin
  1991.   for I := Low(AItems) to High(AItems) do
  1992.     Add(AItems[I]);
  1993. end;
  1994.  
  1995. procedure TMenuItem.Clear;
  1996. var
  1997.   I: Integer;
  1998. begin
  1999.   for I := Count - 1 downto 0 do
  2000.     Items[I].Free;
  2001. end;
  2002.  
  2003. function TMenuItem.InternalRethinkHotkeys(ForceRethink: Boolean): Boolean;
  2004. var
  2005.   vDid, vDoing, vToDo, vBest: TStringList;
  2006.   I, vIteration, vColumn, vAt, vBestCount: Integer;
  2007.   vChar, vCaption, vOrigAvailable, vAvailable, vBestAvailable: string;
  2008.   function IfHotkeyAvailable(const AHotkey: string): Boolean;
  2009.   var
  2010.     At: Integer;
  2011.   begin
  2012.     At := AnsiPos(AHotkey, vAvailable);
  2013.     Result := At <> 0;
  2014.     if Result then
  2015.       System.Delete(vAvailable, At, 1);
  2016.   end;
  2017.   procedure CopyToBest;
  2018.   var
  2019.     I: Integer;
  2020.   begin
  2021.     vBest.Assign(vDid);
  2022.     vBestCount := vDid.Count;
  2023.     for I := 0 to vDoing.Count - 1 do
  2024.       vBest.AddObject(TMenuItem(vDoing.Objects[I]).FCaption, vDoing.Objects[I]);
  2025.     vBestAvailable := vAvailable;
  2026.   end;
  2027.   procedure InsertHotkeyFarEastFormat(var ACaption: string; const AHotKey: string; AColumn: Integer);
  2028.   var
  2029.     I: Integer;
  2030.     vMBCSFlag: Boolean;
  2031.   begin
  2032.     vMBCSFlag := False;
  2033.     for I := 1 to Length(ACaption) do
  2034.       if ACaption[I] in LeadBytes then
  2035.       begin
  2036.         vMBCSFlag := True;
  2037.         System.Break;
  2038.       end;
  2039.     if vMBCSFlag then
  2040.     begin
  2041.       if Copy(ACaption, (Length(ACaption) - Length(cDialogSuffix)) + 1, Length(cDialogSuffix)) = cDialogSuffix then
  2042.         ACaption := Copy(ACaption, 1, Length(ACaption) - Length(cDialogSuffix)) +
  2043.           '(' + cHotkeyPrefix + AHotKey + ')' + cDialogSuffix
  2044.       else
  2045.         ACaption := ACaption + '(' + cHotkeyPrefix + AHotKey + ')';
  2046.     end
  2047.     else if AColumn <> 0 then
  2048.       System.Insert(cHotkeyPrefix, ACaption, AColumn);
  2049.   end;
  2050. begin
  2051.   Result := False;
  2052.   if ForceRethink or
  2053.      (not (csDesigning in ComponentState) and GetAutoHotkeys) then
  2054.   begin
  2055.     vAvailable := ValidMenuHotkeys;
  2056.     vDid := TStringList.Create;
  2057.     vDoing := TStringList.Create;
  2058.     vToDo := TStringList.Create;
  2059.     vBest := TStringList.Create;
  2060.     vBestCount := 0;
  2061.     try
  2062.       for I := 0 to Count - 1 do
  2063.         if Items[I].Visible and
  2064.            (Items[I].FCaption <> cLineCaption) and
  2065.            (Items[I].FCaption <> '') then
  2066.         begin
  2067.           vChar := Uppercase(GetHotkey(Items[I].FCaption));
  2068.           if vChar = '' then
  2069.             vToDo.InsertObject(0, Items[I].FCaption, Items[I])
  2070.           else if (AnsiPos(vChar, ValidMenuHotkeys) <> 0) and
  2071.                   not IfHotkeyAvailable(vChar) then
  2072.           begin
  2073.             Items[I].FCaption := StripHotkey(Items[I].FCaption);
  2074.             vToDo.InsertObject(0, Items[I].FCaption, Items[I]);
  2075.           end;
  2076.         end;
  2077.       vOrigAvailable := vAvailable;
  2078.       for vIteration := 0 to vToDo.Count - 1 do
  2079.       begin
  2080.         vAvailable := vOrigAvailable;
  2081.         vDoing.Assign(vToDo);
  2082.         vDid.Clear;
  2083.         for I := vDoing.Count - 1 downto 0 do
  2084.         begin
  2085.           vCaption := vDoing[I];
  2086.           vColumn := 1;
  2087.           while vColumn <= Length(vCaption) do
  2088.           begin
  2089.             if vCaption[vColumn] in LeadBytes then
  2090.               Inc(vColumn)
  2091.             else
  2092.             begin
  2093.               vChar := Uppercase(Copy(vCaption, vColumn, 1));
  2094.               if IfHotkeyAvailable(vChar) then
  2095.               begin
  2096.                 if SysLocale.FarEast then
  2097.                   InsertHotkeyFarEastFormat(vCaption, vChar, vColumn)
  2098.                 else
  2099.                   System.Insert(cHotkeyPrefix, vCaption, vColumn);
  2100.                 vDid.AddObject(vCaption, vDoing.Objects[I]);
  2101.                 vDoing.Delete(I);
  2102.                 System.Break;
  2103.               end;
  2104.             end;
  2105.             Inc(vColumn);
  2106.           end;
  2107.         end;
  2108.         if vDid.Count > vBestCount then
  2109.           CopyToBest;
  2110.         if vDoing.Count > 0 then
  2111.           for I := 0 to vDoing.Count - 1 do
  2112.           begin
  2113.             vAt := vToDo.IndexOfObject(vDoing.Objects[I]);
  2114.             vToDo.Move(vAt, vToDo.Count - 1);
  2115.           end
  2116.         else
  2117.           System.Break;
  2118.       end;
  2119.       if vBestCount = 0 then
  2120.         CopyToBest;
  2121.       Result := vBest.Count > 0;
  2122.       for I := 0 to vBest.Count - 1 do
  2123.       begin
  2124.         vCaption := vBest[I];
  2125.         if SysLocale.FarEast and (AnsiPos(cHotkeyPrefix, vCaption) = 0)
  2126.           and (vBestAvailable <> '') then
  2127.         begin
  2128.           if AnsiPos(cHotkeyPrefix, vCaption) = 0 then
  2129.           begin
  2130.             InsertHotkeyFarEastFormat(vCaption, Copy(vBestAvailable, Length(vBestAvailable), 1), 0);
  2131.             System.Delete(vBestAvailable, length(vBestAvailable), 1);
  2132.           end;
  2133.         end;
  2134.         TMenuItem(vBest.Objects[I]).FCaption := vCaption;
  2135.       end;
  2136.     finally
  2137.       vBest.Free;
  2138.       vToDo.Free;
  2139.       vDoing.Free;
  2140.       vDid.Free;
  2141.     end;
  2142.   end;
  2143. end;
  2144.  
  2145. function TMenuItem.RethinkHotkeys: Boolean;
  2146. begin
  2147.   Result := InternalRethinkHotkeys(True);
  2148.   if Result then
  2149.     MenuChanged(True);
  2150. end;
  2151.  
  2152. procedure TMenuItem.SetAutoHotkeys(const Value: TMenuItemAutoFlag);
  2153. begin
  2154.   if Value <> FAutoHotkeys then
  2155.   begin
  2156.     FAutoHotkeys := Value;
  2157.     MenuChanged(True);
  2158.   end;
  2159. end;
  2160.  
  2161. function TMenuItem.IsLine: Boolean;
  2162. begin
  2163.   Result := FCaption = cLineCaption;
  2164. end;
  2165.  
  2166. function TMenuItem.Find(ACaption: string): TMenuItem;
  2167. var
  2168.   I: Integer;
  2169. begin
  2170.   Result := nil;
  2171.   ACaption := StripHotkey(ACaption);
  2172.   for I := 0 to Count - 1 do
  2173.     if AnsiSameText(ACaption, StripHotkey(Items[I].Caption)) then
  2174.     begin
  2175.       Result := Items[I];
  2176.       System.Break;
  2177.     end;
  2178. end;
  2179.  
  2180. function TMenuItem.InsertNewLine(ABefore: Boolean; AItem: TMenuItem): Integer;
  2181. begin
  2182.   if AItem.Parent <> Self then
  2183.      Error(@SMenuNotFound);
  2184.   if ABefore then
  2185.   begin
  2186.     if (AItem.MenuIndex > 0) and
  2187.        Items[AItem.MenuIndex - 1].IsLine then
  2188.     begin
  2189.       Result := AItem.MenuIndex - 1;
  2190.       Items[AItem.MenuIndex - 1].Visible := True;
  2191.     end
  2192.     else
  2193.     begin
  2194.       Result := AItem.MenuIndex;
  2195.       Insert(AItem.MenuIndex, NewLine);
  2196.     end;
  2197.   end
  2198.   else
  2199.   begin
  2200.     if (AItem.MenuIndex < Count - 1) and
  2201.        Items[AItem.MenuIndex + 1].IsLine then
  2202.     begin
  2203.       Result := AItem.MenuIndex + 2;
  2204.       Items[AItem.MenuIndex + 1].Visible := True;
  2205.     end
  2206.     else
  2207.     begin
  2208.       Result := AItem.MenuIndex + 2;
  2209.       Insert(AItem.MenuIndex + 1, NewLine);
  2210.     end;
  2211.   end;
  2212. end;
  2213.  
  2214. function TMenuItem.InsertNewLineAfter(AItem: TMenuItem): Integer;
  2215. begin
  2216.   Result := InsertNewLine(False, AItem);
  2217. end;
  2218.  
  2219. function TMenuItem.InsertNewLineBefore(AItem: TMenuItem): Integer;
  2220. begin
  2221.   Result := InsertNewLine(True, AItem);
  2222. end;
  2223.  
  2224. function TMenuItem.NewBottomLine: Integer;
  2225. begin
  2226.   Result := 0;
  2227.   if Count = 0 then
  2228.     Add(NewLine)
  2229.   else
  2230.     Result := InsertNewLine(False, Items[Count - 1]);
  2231. end;
  2232.  
  2233. function TMenuItem.NewTopLine: Integer;
  2234. begin
  2235.   Result := 0;
  2236.   if Count = 0 then
  2237.     Add(NewLine)
  2238.   else
  2239.     Result := InsertNewLine(True, Items[0]);
  2240. end;
  2241.  
  2242. function TMenuItem.InternalRethinkLines(ForceRethink: Boolean): Boolean;
  2243. var
  2244.   I, vLastAt: Integer;
  2245.   vLastBar: TMenuItem;
  2246. begin
  2247.   Result := False;
  2248.   if ForceRethink or
  2249.      (not (csDesigning in ComponentState) and GetAutoLineReduction) then
  2250.   begin
  2251.     vLastAt := 0;
  2252.     vLastBar := nil;
  2253.     for I := vLastAt to Count - 1 do
  2254.       if Items[I].FVisible then
  2255.         if Items[I].IsLine then
  2256.         begin
  2257.           Items[I].FVisible := False;
  2258.           Result := True;
  2259.         end
  2260.         else
  2261.         begin
  2262.           vLastAt := I;
  2263.           System.Break;
  2264.         end;
  2265.     for I := vLastAt to Count - 1 do
  2266.       if Items[I].IsLine then
  2267.       begin
  2268.         if vLastBar <> nil then
  2269.         begin
  2270.           vLastBar.FVisible := False;
  2271.           Result := True;
  2272.         end;
  2273.         vLastBar := Items[I];
  2274.       end
  2275.       else if Items[I].FVisible then
  2276.       begin
  2277.         if vLastBar <> nil then
  2278.         begin
  2279.           vLastBar.FVisible := True;
  2280.           Result := True;
  2281.         end;
  2282.         vLastBar := nil;
  2283.         vLastAt := I;
  2284.       end;
  2285.     for I := Count - 1 downto vLastAt do
  2286.       if Items[I].FVisible then
  2287.         if Items[I].IsLine then
  2288.         begin
  2289.           Items[I].FVisible := False;
  2290.           Result := True;
  2291.         end
  2292.         else
  2293.           System.Break;
  2294.   end;
  2295. end;
  2296.  
  2297. procedure TMenuItem.SetAutoLineReduction(const Value: TMenuItemAutoFlag);
  2298. begin
  2299.   if Value <> FAutoLineReduction then
  2300.   begin
  2301.     FAutoLineReduction := Value;
  2302.     MenuChanged(True);
  2303.   end;
  2304. end;
  2305.  
  2306. function TMenuItem.RethinkLines: Boolean;
  2307. begin
  2308.   Result := InternalRethinkLines(True);
  2309.   if Result then
  2310.     MenuChanged(True);
  2311. end;
  2312.  
  2313. function TMenuItem.GetAutoHotkeys: Boolean;
  2314. var
  2315.   vAuto: TMenuItemAutoFlag;
  2316. begin
  2317.   vAuto := FAutoHotkeys;
  2318.   if (vAuto = maParent) and
  2319.      (Parent <> nil) then
  2320.     vAuto := cBooleanToItemAutoFlag[Parent.GetAutoHotkeys];
  2321.   Result := cItemAutoFlagToBoolean[vAuto];
  2322. end;
  2323.  
  2324. function TMenuItem.GetAutoLineReduction: Boolean;
  2325. var
  2326.   vAuto: TMenuItemAutoFlag;
  2327. begin
  2328.   vAuto := FAutoLineReduction;
  2329.   if (vAuto = maParent) and
  2330.      (Parent <> nil) then
  2331.     vAuto := cBooleanToItemAutoFlag[Parent.GetAutoLineReduction];
  2332.   Result := cItemAutoFlagToBoolean[vAuto];
  2333. end;
  2334.  
  2335. { TMenu }
  2336.  
  2337. constructor TMenu.Create(AOwner: TComponent);
  2338. begin
  2339.   FItems := TMenuItem.Create(Self);
  2340.   FItems.FOnChange := MenuChanged;
  2341.   FItems.FMenu := Self;
  2342.   FImageChangeLink := TChangeLink.Create;
  2343.   FImageChangeLink.OnChange := ImageListChange;
  2344.   FParentBiDiMode := True;
  2345.   inherited Create(AOwner);
  2346.   FItems.FAutoHotkeys := maAutomatic;
  2347.   FItems.FAutoLineReduction := maAutomatic;
  2348.   ParentBiDiModeChanged;
  2349. end;
  2350.  
  2351. destructor TMenu.Destroy;
  2352. begin
  2353.   FItems.Free;
  2354.   FImageChangeLink.Free;
  2355.   inherited Destroy;
  2356. end;
  2357.  
  2358. procedure TMenu.GetChildren(Proc: TGetChildProc; Root: TComponent);
  2359. begin
  2360.   FItems.GetChildren(Proc, Root);
  2361. end;
  2362.  
  2363. function TMenu.GetHandle: HMENU;
  2364. begin
  2365.   Result := FItems.GetHandle;
  2366. end;
  2367.  
  2368. procedure TMenu.SetChildOrder(Child: TComponent; Order: Integer);
  2369. begin
  2370.   FItems.SetChildOrder(Child, Order);
  2371. end;
  2372.  
  2373. procedure TMenu.UpdateItems;
  2374.  
  2375.   function UpdateItem(MenuItem: TMenuItem): Boolean;
  2376.   begin
  2377.     Result := False;
  2378.     IterateMenus(@UpdateItem, MenuItem.FMerged, MenuItem);
  2379.     MenuItem.SubItemChanged(MenuItem, MenuItem, True);
  2380.   end;
  2381.  
  2382. begin
  2383.   IterateMenus(@UpdateItem, Items.FMerged, Items);
  2384. end;
  2385.  
  2386. function TMenu.FindItem(Value: Integer; Kind: TFindItemKind): TMenuItem;
  2387. var
  2388.   FoundItem: TMenuItem;
  2389.  
  2390.   function Find(Item: TMenuItem): Boolean;
  2391.   var
  2392.     I: Integer;
  2393.   begin
  2394.     Result := False;
  2395.     if ((Kind = fkCommand) and (Value = Item.Command)) or
  2396.       ((Kind = fkHandle) and (Value = Integer(Item.FHandle))) or
  2397.       ((Kind = fkShortCut) and (Value = Item.ShortCut)) then
  2398.     begin
  2399.       FoundItem := Item;
  2400.       Result := True;
  2401.       Exit;
  2402.     end
  2403.     else
  2404.       for I := 0 to Item.GetCount - 1 do
  2405.         if Find(Item[I]) then
  2406.         begin
  2407.           Result := True;
  2408.           Exit;
  2409.         end;
  2410.   end;
  2411.  
  2412. begin
  2413.   FoundItem := nil;
  2414.   IterateMenus(@Find, Items.FMerged, Items);
  2415.   Result := FoundItem;
  2416. end;
  2417.  
  2418. function TMenu.GetHelpContext(Value: Integer; ByCommand: Boolean): THelpContext;
  2419. var
  2420.   Item: TMenuItem;
  2421.   Kind: TFindItemKind;
  2422. begin
  2423.   Result := 0;
  2424.   Kind := fkHandle;
  2425.   if ByCommand then Kind := fkCommand;
  2426.   if (Kind = fkHandle) and (Self is TPopupMenu) and
  2427.     (Integer(TPopupMenu(Self).Handle) = Value) then
  2428.     Result := TPopupMenu(Self).HelpContext
  2429.   else
  2430.   begin
  2431.     Item := FindItem(Value, Kind);
  2432.     while (Item <> nil) and (Item.FHelpContext = 0) do
  2433.       Item := Item.FParent;
  2434.     if Item <> nil then Result := Item.FHelpContext;
  2435.   end;
  2436. end;
  2437.  
  2438. function TMenu.DispatchCommand(ACommand: Word): Boolean;
  2439. var
  2440.   Item: TMenuItem;
  2441. begin
  2442.   Result := False;
  2443.   Item := FindItem(ACommand, fkCommand);
  2444.   if Item <> nil then
  2445.   begin
  2446.     Item.Click;
  2447.     Result := True;
  2448.   end;
  2449. end;
  2450.  
  2451. function TMenu.DispatchPopup(AHandle: HMENU): Boolean;
  2452. var
  2453.   Item: TMenuItem;
  2454. begin
  2455.   Result := False;
  2456.   Item := FindItem(AHandle, fkHandle);
  2457.   if Item <> nil then
  2458.   begin
  2459.     if not (csDesigning in Item.ComponentState) then Item.InitiateActions;
  2460.     Item.Click;
  2461.     if Item.InternalRethinkHotkeys(False) or
  2462.        Item.InternalRethinkLines(False) then
  2463.       Item.RebuildHandle;
  2464.     Result := True;
  2465.   end
  2466.   else if not (csDesigning in ComponentState) and (Self is TPopupMenu) then
  2467.     Items.InitiateActions;
  2468. end;
  2469.  
  2470. function TMenu.IsOwnerDraw: Boolean;
  2471. begin
  2472.   Result := OwnerDraw or (Images <> nil);
  2473. end;
  2474.  
  2475. function TMenu.IsShortCut(var Message: TWMKey): Boolean;
  2476. type
  2477.   TClickResult = (crDisabled, crClicked, crShortCutMoved, crShortCutFreed);
  2478. const
  2479.   AltMask = $20000000;
  2480. var
  2481.   ShortCut: TShortCut;
  2482.   ClickResult: TClickResult;
  2483.   ShortCutItem: TMenuItem;
  2484.  
  2485.   function NthParentOf(Item: TMenuItem; N: Integer): TMenuItem;
  2486.   begin
  2487.     Result := Item;
  2488.     while (N > 0) and (Result <> nil) do
  2489.     begin
  2490.       Result := Result.Parent;
  2491.       Dec(N);
  2492.     end;
  2493.   end;
  2494.  
  2495.   function DoClick(var Item: TMenuItem; Level: Integer): TClickResult;
  2496.   var
  2497.     ItemParent: TMenuItem;
  2498.   begin
  2499.     Result := crClicked;
  2500.     ItemParent := Item.Parent;
  2501.     // Assert(Item = NthParentOf(ShortCutItem, Level));
  2502.     if ItemParent <> nil then Result := DoClick(ItemParent, Level + 1);
  2503.     if Result in [crDisabled, crShortCutFreed] then Exit;
  2504.     if Result = crShortCutMoved then
  2505.     begin
  2506.       // Shortcut moved, we need to refind the shortcut and restore Item
  2507.       // to point to the parent at the right level, if possible
  2508.       if (ShortCutItem = nil) or (ShortCutItem.ShortCut <> ShortCut) then
  2509.       begin
  2510.         ShortCutItem := FindItem(ShortCut, fkShortCut);
  2511.         if ShortCutItem = nil then
  2512.         begin
  2513.           Result := crShortCutFreed;
  2514.           Exit; // Shortcut item could not be found
  2515.         end;
  2516.       end;
  2517.       Item := NthParentOf(ShortCutItem, Level);
  2518.       if (Item = nil) or (Item.Parent <> ItemParent) then
  2519.         Exit; // Shortcut moved in structure, level not correct
  2520.       if Level = 0 then Result := crClicked;
  2521.     end;
  2522.     if Item.Enabled then
  2523.       try
  2524.         if not (csDesigning in ComponentState) then Item.InitiateActions;
  2525.         Item.Click;
  2526.         if (ShortCutItem = nil) or
  2527.           ((Item <> ShortCutItem) and (ShortCutItem.ShortCut <> ShortCut)) then
  2528.           Result := crShortCutMoved;
  2529.       except
  2530.         Application.HandleException(Self);
  2531.       end
  2532.     else Result := crDisabled;
  2533.   end;
  2534.  
  2535. begin
  2536. //! Moved checking FWindowHandle to TWinControl and TForm.  This way we can
  2537. //! call this method on menus which aren't necessarily allocated.  More
  2538. //! specifically, we can make toolbar menus much more dynamic. [rbr]
  2539.  
  2540. //!  Result := False;
  2541. //!  if FWindowHandle <> 0 then
  2542.   begin
  2543.     ShortCut := Byte(Message.CharCode);
  2544.     if GetKeyState(VK_SHIFT) < 0 then Inc(ShortCut, scShift);
  2545.     if GetKeyState(VK_CONTROL) < 0 then Inc(ShortCut, scCtrl);
  2546.     if Message.KeyData and AltMask <> 0 then Inc(ShortCut, scAlt);
  2547.     repeat
  2548.       ClickResult := crDisabled;
  2549.       ShortCutItem := FindItem(ShortCut, fkShortCut);
  2550.       if ShortCutItem <> nil then
  2551.       begin
  2552.         ShortCutItems.Push(@ShortCutItem);
  2553.         try
  2554.           ClickResult := DoClick(ShortCutItem, 0);
  2555.         finally
  2556.           ShortCutItems.Pop;
  2557.         end;  
  2558.       end;
  2559.     until ClickResult <> crShortCutMoved;
  2560.     Result := ShortCutItem <> nil;
  2561.   end;
  2562. end;
  2563.  
  2564. function TMenu.IsBiDiModeStored: Boolean;
  2565. begin
  2566.   Result := not FParentBiDiMode;
  2567. end;
  2568.  
  2569. procedure TMenu.DoBiDiModeChanged;
  2570. var
  2571.   Menu: HMENU;
  2572.   MenuItemInfo: TMenuItemInfo;
  2573.   Buffer: array[0..79] of Char;
  2574. begin
  2575.   if (not SysLocale.MiddleEast) or (WindowHandle = 0) then Exit;
  2576.   Menu := GetHandle;
  2577.   MenuItemInfo.cbSize := 44; // Required for Windows 95
  2578.   MenuItemInfo.fMask := MIIM_TYPE;
  2579.   MenuItemInfo.dwTypeData := Buffer;
  2580.   MenuItemInfo.cch := SizeOf(Buffer);
  2581.   if GetMenuItemInfo(Menu, 0, True, MenuItemInfo) then
  2582.   begin
  2583.     if LongBool(MenuItemInfo.fType and RightToLeftMenuFlag) = IsRightToLeft then
  2584.       Exit;  // Nothing to do
  2585.     // clear and set the flag
  2586.     MenuItemInfo.fType := (MenuItemInfo.fType and (not RightToLeftMenuFlag))
  2587.       or (RightToLeftMenuFlag * DWORD(IsRightToLeft));
  2588.     MenuItemInfo.fMask := MIIM_TYPE;
  2589.     if SetMenuItemInfo(Menu, 0, True, MenuItemInfo) then
  2590.       DrawMenuBar(WindowHandle);
  2591.   end;
  2592. end;
  2593.  
  2594. function TMenu.UpdateImage: Boolean;
  2595. var
  2596.   Image: array[0..511] of Char;
  2597.  
  2598.   procedure BuildImage(Menu: HMENU);
  2599.   var
  2600.     P, ImageEnd: PChar;
  2601.     I, C: Integer;
  2602.     State: Word;
  2603.   begin
  2604.     C := GetMenuItemCount(Menu);
  2605.     P := Image;
  2606.     ImageEnd := @Image[SizeOf(Image) - 5];
  2607.     I := 0;
  2608.     while (I < C) and (P < ImageEnd) do
  2609.     begin
  2610.       DoGetMenuString(Menu, I, P, ImageEnd - P, MF_BYPOSITION);
  2611.       P := StrEnd(P);
  2612.       State := GetMenuState(Menu, I, MF_BYPOSITION);
  2613.       if State and MF_DISABLED <> 0 then
  2614.       begin
  2615.         P^ := '$';
  2616.         Inc(P);
  2617.         P^ := #0;
  2618.       end;
  2619.       if State and MF_MENUBREAK <> 0 then
  2620.       begin
  2621.         P^ := '@';
  2622.         Inc(P);
  2623.         P^ := #0;
  2624.       end;
  2625.       if State and MF_GRAYED <> 0 then
  2626.       begin
  2627.         P^ := '#';
  2628.         Inc(P);
  2629.         P^ := #0;
  2630.       end;
  2631.       P^ := ';';
  2632.       Inc(P);
  2633.       P^ := #0;
  2634.       Inc(I);
  2635.     end;
  2636.   end;
  2637.  
  2638. begin
  2639.   Result := False;
  2640.   Image[0] := #0;
  2641.   if FWindowHandle <> 0 then BuildImage(Handle);
  2642.   if (FMenuImage = '') or (StrComp(PChar(FMenuImage), Image) <> 0) then
  2643.   begin
  2644.     Result := True;
  2645.     FMenuImage := Image;
  2646.   end;
  2647. end;
  2648.  
  2649. procedure TMenu.SetOwnerDraw(Value: Boolean);
  2650. begin
  2651.   if Value <> FOwnerDraw then
  2652.   begin
  2653.     FOwnerDraw := Value;
  2654.     UpdateItems;
  2655.   end;
  2656. end;
  2657.  
  2658. procedure TMenu.AdjustBiDiBehavior;
  2659. var
  2660.   SaveBiDi: TBiDiMode;
  2661.   SaveParentBiDi: Boolean;
  2662. begin
  2663.   if not SysLocale.MiddleEast then Exit;
  2664.   SaveBiDi := FBiDiMode;
  2665.   SaveParentBiDi := FParentBidiMode;
  2666.   try
  2667.     if BiDiMode = bdLeftToRight then
  2668.       BiDiMode := bdRightToLeft { Do not use FBiDiMode }
  2669.     else
  2670.       BiDiMode := bdLeftToRight; { Do not use FBiDiMode }
  2671.   finally
  2672.     BiDiMode := SaveBiDi; { Do not use FBiDiMode }
  2673.     FParentBidiMode := SaveParentBiDi;
  2674.   end;
  2675. end;
  2676.  
  2677. procedure TMenu.SetWindowHandle(Value: HWND);
  2678. begin
  2679.   FWindowHandle := Value;
  2680.   UpdateImage;
  2681.   { When menus are created, if BiDiMode does not follow the parent,
  2682.     main menu headers are displayed in reversed order. Changing BiDiMode
  2683.     twice fixes this. }
  2684.   if (SysLocale.MiddleEast) and (Value <> 0) then
  2685.     if FParentBiDiMode then
  2686.       ParentBiDiModeChanged
  2687.     else
  2688.       AdjustBiDiBehavior;
  2689. end;
  2690.  
  2691. procedure TMenu.DoChange(Source: TMenuItem; Rebuild: Boolean);
  2692. begin
  2693.   if Assigned(FOnChange) then FOnChange(Self, Source, Rebuild);
  2694. end;
  2695.  
  2696. procedure TMenu.Loaded;
  2697. begin
  2698.   inherited Loaded;
  2699.   DoChange(nil, False);
  2700. end;
  2701.  
  2702. procedure TMenu.MenuChanged(Sender: TObject; Source: TMenuItem; Rebuild: Boolean);
  2703. begin
  2704.   if ComponentState * [csLoading, csDestroying] = [] then DoChange(Source, Rebuild);
  2705. end;
  2706.  
  2707. procedure TMenu.ImageListChange(Sender: TObject);
  2708. begin
  2709.   if Sender = Images then UpdateItems;
  2710. end;
  2711.  
  2712. procedure TMenu.SetImages(Value: TCustomImageList);
  2713. begin
  2714.   if FImages <> nil then FImages.UnRegisterChanges(FImageChangeLink);
  2715.   FImages := Value;
  2716.   if FImages <> nil then
  2717.   begin
  2718.     FImages.RegisterChanges(FImageChangeLink);
  2719.     FImages.FreeNotification(Self);
  2720.   end;
  2721.   UpdateItems;
  2722. end;
  2723.  
  2724. procedure TMenu.Notification(AComponent: TComponent;
  2725.   Operation: TOperation);
  2726. begin
  2727.   inherited Notification(AComponent, Operation);
  2728.   if (AComponent = Images) and (Operation = opRemove) then Images := nil;
  2729. end;
  2730.  
  2731. function TMenu.IsRightToLeft: Boolean;
  2732. begin
  2733.   Result := SysLocale.MiddleEast and (BiDiMode <> bdLeftToRight);
  2734. end;
  2735.  
  2736. procedure TMenu.ProcessMenuChar(var Message: TWMMenuChar);
  2737. var
  2738.   C, I, First, Hilite, Next: Integer;
  2739.   State: Word;
  2740.  
  2741.   function IsAccelChar(Menu: HMENU; State: Word; I: Integer; C: Char): Boolean;
  2742.   var
  2743.     Item: TMenuItem;
  2744.     Id: UINT;
  2745.   begin
  2746.     Item := nil;
  2747.     if State and MF_POPUP <> 0 then
  2748.     begin
  2749.       Menu := GetSubMenu(Menu, I);
  2750.       Item := FindItem(Menu, fkHandle);
  2751.     end
  2752.     else
  2753.     begin
  2754.       Id := GetMenuItemID(Menu, I);
  2755.       if Id <> $FFFFFFFF then
  2756.         Item := FindItem(Id, fkCommand);
  2757.     end;
  2758.     if Item <> nil then
  2759.       Result := IsAccel(Ord(C), Item.Caption) else
  2760.       Result := False;
  2761.   end;
  2762.  
  2763.   function IsInitialChar(Menu: HMENU; State: Word; I: Integer; C: Char): Boolean;
  2764.   var
  2765.     Item: TMenuItem;
  2766.   begin
  2767.     if State and MF_POPUP <> 0 then
  2768.     begin
  2769.       Menu := GetSubMenu(Menu, I);
  2770.       Item := FindItem(Menu, fkHandle);
  2771.     end
  2772.     else
  2773.     begin
  2774.       Item := FindItem(Menu, fkHandle);
  2775.       if (Item <> nil) and (I < Item.Count) then
  2776.         Item := Item.Items[I];
  2777.     end;
  2778.     // First char is a valid accelerator only if the caption does not
  2779.     // contain an explicit accelerator
  2780.     if (Item <> nil) and (Item.Caption <> '') then
  2781.       Result := (AnsiCompareText(Item.Caption[1], C) = 0) and
  2782.         (GetHotkey(Item.Caption) = '')
  2783.     else
  2784.       Result := False;
  2785.   end;
  2786.  
  2787. begin
  2788.   with Message do
  2789.   begin
  2790.     Result := MNC_IGNORE; { No item found: beep }
  2791.     First := -1;
  2792.     Hilite := -1;
  2793.     Next := -1;
  2794.     C := GetMenuItemCount(Menu);
  2795.     for I := 0 to C - 1 do
  2796.     begin
  2797.       State := GetMenuState(Menu, I, MF_BYPOSITION);
  2798.       if IsAccelChar(Menu, State, I, User) then
  2799.       begin
  2800.         if State and MF_DISABLED <> 0 then
  2801.         begin
  2802.           { Close the menu if this is the only disabled item to choose from.
  2803.             Otherwise, ignore the item. }
  2804.           if First < 0 then First := -2;
  2805.           Continue;
  2806.         end;
  2807.         if First < 0 then
  2808.         begin
  2809.           First := I;
  2810.           Result := MNC_EXECUTE;
  2811.         end
  2812.         else
  2813.           Result := MNC_SELECT;
  2814.         if State and MF_HILITE <> 0 then
  2815.           Hilite := I
  2816.         else if Hilite >= 0 then
  2817.           Next := I;
  2818.       end;
  2819.     end;
  2820.     { We found a single disabled item. End the selection. }
  2821.     if First < -1 then
  2822.     begin
  2823.       Result := MNC_CLOSE shl 16;
  2824.       Exit;
  2825.     end;
  2826.  
  2827.     { If we can't find accelerators, then look for initial letters }
  2828.     if First < 0 then
  2829.     for I := 0 to C - 1 do
  2830.       begin
  2831.         State := GetMenuState(Menu, I, MF_BYPOSITION);
  2832.         if IsInitialChar(Menu, State, I, User) then
  2833.         begin
  2834.           if State and MF_DISABLED <> 0 then
  2835.           begin
  2836.             Result := MNC_CLOSE shl 16;
  2837.             Exit;
  2838.           end;
  2839.           if First < 0 then
  2840.           begin
  2841.             First := I;
  2842.             Result := MNC_EXECUTE;
  2843.           end
  2844.           else
  2845.             Result := MNC_SELECT;
  2846.           if State and MF_HILITE <> 0 then
  2847.             Hilite := I
  2848.           else if Hilite >= 0 then
  2849.             Next := I;
  2850.         end;
  2851.       end;
  2852.  
  2853.     if (Result = MNC_EXECUTE) then
  2854.       Result := Result shl 16 or First
  2855.     else if Result = MNC_SELECT then
  2856.     begin
  2857.       if Next < 0 then
  2858.         Next := First;
  2859.       Result := Result shl 16 or Next;
  2860.     end;
  2861.   end;
  2862. end;
  2863.  
  2864. { Returns the proper caption for a menu item when the menu is owner-drawn. }
  2865. function TMenu.DoGetMenuString(Menu: HMENU; ItemID: UINT; Str: PChar;
  2866.   MaxCount: Integer; Flag: UINT): Integer;
  2867. var
  2868.   Item: TMenuItem;
  2869.   State: Word;
  2870. begin
  2871.   if IsOwnerDraw then
  2872.   begin
  2873.     Item := nil;
  2874.     State := GetMenuState(Menu, ItemID, Flag);
  2875.     if State and MF_POPUP <> 0 then
  2876.     begin
  2877.       Menu := GetSubMenu(Menu, ItemID);
  2878.       Item := FindItem(Menu, fkHandle);
  2879.     end
  2880.     else
  2881.     begin
  2882.       ItemID := GetMenuItemID(Menu, ItemID);
  2883.       if ItemID <> $FFFFFFFF then
  2884.         Item := FindItem(ItemID, fkCommand);
  2885.     end;
  2886.     if Item <> nil then
  2887.     begin
  2888.       Str[0] := #0;
  2889.       StrPLCopy(Str, Item.Caption, MaxCount);
  2890.       Result := StrLen(Str);
  2891.     end
  2892.     else
  2893.       Result := 0;
  2894.   end
  2895.   else
  2896.     Result := GetMenuString(Menu, ItemID, Str, MaxCount, Flag);
  2897. end;
  2898.  
  2899. procedure TMenu.SetBiDiMode(Value: TBiDiMode);
  2900. begin
  2901.   if FBiDiMode <> Value then
  2902.   begin
  2903.     FBiDiMode := Value;
  2904.     FParentBiDiMode := False;
  2905.     DoBiDiModeChanged;
  2906.   end;
  2907. end;
  2908.  
  2909. procedure TMenu.SetParentBiDiMode(Value: Boolean);
  2910. begin
  2911.   if Value <> FParentBiDiMode then
  2912.   begin
  2913.     FParentBiDiMode := Value;
  2914.     ParentBiDiModeChanged;
  2915.   end;
  2916. end;
  2917.  
  2918. procedure TMenu.ParentBiDiModeChanged;
  2919. var
  2920.   AForm: TWinControl;
  2921. begin
  2922.   if FParentBiDiMode then
  2923.   begin
  2924.     AForm := FindControl(WindowHandle);
  2925.     if AForm <> nil then
  2926.     begin
  2927.       BiDiMode := AForm.BiDiMode;
  2928.       FParentBiDiMode := True;
  2929.     end;
  2930.   end;
  2931. end;
  2932.  
  2933. procedure TMenu.ParentBiDiModeChanged(AControl: TObject);
  2934. begin
  2935.   if FParentBiDiMode then
  2936.   begin
  2937.     BiDiMode := (AControl as TControl).BiDiMode;
  2938.     FParentBiDiMode := True;
  2939.   end;
  2940. end;
  2941.  
  2942. function TMenu.GetAutoHotkeys: TMenuAutoFlag;
  2943. begin
  2944.   Result := cItemAutoFlagToMenu[Items.FAutoHotkeys];
  2945. end;
  2946.  
  2947. procedure TMenu.SetAutoHotkeys(const Value: TMenuAutoFlag);
  2948. begin
  2949.   Items.FAutoHotkeys := cMenuAutoFlagToItem[Value];
  2950. end;
  2951.  
  2952. function TMenu.GetAutoLineReduction: TMenuAutoFlag;
  2953. begin
  2954.   Result := cItemAutoFlagToMenu[Items.FAutoLineReduction];
  2955. end;
  2956.  
  2957. procedure TMenu.SetAutoLineReduction(const Value: TMenuAutoFlag);
  2958. begin
  2959.   Items.FAutoLineReduction := cMenuAutoFlagToItem[Value];
  2960. end;
  2961.  
  2962. { TMainMenu }
  2963.  
  2964. procedure TMainMenu.SetAutoMerge(Value: Boolean);
  2965. begin
  2966.   if FAutoMerge <> Value then
  2967.   begin
  2968.     FAutoMerge := Value;
  2969.     if FWindowHandle <> 0 then
  2970.       SendMessage(FWindowHandle, CM_MENUCHANGED, 0, 0);
  2971.   end;
  2972. end;
  2973.  
  2974. procedure TMainMenu.MenuChanged(Sender: TObject; Source: TMenuItem; Rebuild: Boolean);
  2975. var
  2976.   NeedUpdate: Boolean;
  2977. begin
  2978.   if (FWindowHandle <> 0) then
  2979.   begin
  2980.     NeedUpdate := UpdateImage;  // check for changes before CM_MENUCHANGED does 
  2981.     if Source = nil then SendMessage(FWindowHandle, CM_MENUCHANGED, 0, 0);
  2982.     if NeedUpdate then DrawMenuBar(FWindowHandle);
  2983.   end;
  2984.   inherited MenuChanged(Sender, Source, Rebuild);
  2985. end;
  2986.  
  2987. procedure TMainMenu.Merge(Menu: TMainMenu);
  2988. begin
  2989.   if Menu <> nil then
  2990.     FItems.MergeWith(Menu.FItems) else
  2991.     FItems.MergeWith(nil);
  2992. end;
  2993.  
  2994. procedure TMainMenu.Unmerge(Menu: TMainMenu);
  2995. begin
  2996.   if (Menu <> nil) and (FItems.FMerged = Menu.FItems) then
  2997.     FItems.MergeWith(nil);
  2998. end;
  2999.  
  3000. procedure TMainMenu.ItemChanged;
  3001. begin
  3002.   MenuChanged(nil, nil, False);
  3003.   if FWindowHandle <> 0 then
  3004.     SendMessage(FWindowHandle, CM_MENUCHANGED, 0, 0);
  3005. end;
  3006.  
  3007. function TMainMenu.GetHandle: HMENU;
  3008. begin
  3009.   if FOle2Menu <> 0 then
  3010.     Result := FOle2Menu else
  3011.     Result := inherited GetHandle;
  3012. end;
  3013.  
  3014. procedure TMainMenu.GetOle2AcceleratorTable(var AccelTable: HAccel;
  3015.   var AccelCount: Integer; Groups: array of Integer);
  3016. var
  3017.   NumAccels: Integer;
  3018.   AccelList, AccelPtr: PAccel;
  3019.  
  3020.   procedure ProcessAccels(Item: TMenuItem);
  3021.   var
  3022.     I: Integer;
  3023.     Virt: Byte;
  3024.   begin
  3025.     if Item.ShortCut <> 0 then
  3026.       if AccelPtr <> nil then
  3027.       begin
  3028.         Virt := FNOINVERT or FVIRTKEY;
  3029.         if Item.ShortCut and scCtrl <> 0 then Virt := Virt or FCONTROL;
  3030.         if Item.ShortCut and scAlt <> 0 then Virt := Virt or FALT;
  3031.         if Item.ShortCut and scShift <> 0 then Virt := Virt or FSHIFT;
  3032.         AccelPtr^.fVirt := Virt;
  3033.         AccelPtr^.key := Item.ShortCut and $FF;
  3034.         AccelPtr^.cmd := Item.Command;
  3035.         Inc(AccelPtr);
  3036.       end else
  3037.         Inc(NumAccels)
  3038.     else
  3039.       for I := 0 to Item.GetCount - 1 do ProcessAccels(Item[I]);
  3040.   end;
  3041.  
  3042.   function ProcessAccelItems(Item: TMenuItem): Boolean;
  3043.   var
  3044.     I: Integer;
  3045.   begin
  3046.     for I := 0 to High(Groups) do
  3047.       if Item.GroupIndex = Groups[I] then
  3048.       begin
  3049.         ProcessAccels(Item);
  3050.         Break;
  3051.       end;
  3052.     Result := False;
  3053.   end;
  3054.  
  3055. begin
  3056.   NumAccels := 0;
  3057.   AccelPtr := nil;
  3058.   IterateMenus(@ProcessAccelItems, Items.FMerged, Items);
  3059.   AccelTable := 0;
  3060.   if NumAccels <> 0 then
  3061.   begin
  3062.     GetMem(AccelList, NumAccels * SizeOf(TAccel));
  3063.     AccelPtr := AccelList;
  3064.     IterateMenus(@ProcessAccelItems, Items.FMerged, Items);
  3065.     AccelTable := CreateAcceleratorTable(AccelList^, NumAccels);
  3066.     FreeMem(AccelList);
  3067.   end;
  3068.   AccelCount := NumAccels;
  3069. end;
  3070.  
  3071. { Similar to regular TMenuItem.PopulateMenus except that it only adds
  3072.   the specified groups to the menu handle }
  3073.  
  3074. procedure TMainMenu.PopulateOle2Menu(SharedMenu: HMenu;
  3075.   Groups: array of Integer; var Widths: array of Longint);
  3076. var
  3077.   NumGroups: Integer;
  3078.   J: Integer;
  3079.   MenuRightToLeft: Boolean;
  3080.     
  3081.   function AddOle2(Item: TMenuItem): Boolean;
  3082.   var
  3083.     I: Integer;
  3084.   begin
  3085.     for I := 0 to NumGroups do
  3086.     begin
  3087.       if Item.GroupIndex = Groups[I] then
  3088.       begin
  3089.         Inc(Widths[Item.GroupIndex]);
  3090.         Item.AppendTo(SharedMenu, MenuRightToLeft);
  3091.       end;
  3092.     end;
  3093.     Result := False;
  3094.   end;
  3095.     
  3096. begin
  3097.   MenuRightToLeft := IsRightToLeft;
  3098.   NumGroups := High(Groups);
  3099.   for J := 0 to High(Widths) do Widths[J] := 0;
  3100.   IterateMenus(@AddOle2, Items.FMerged, Items);
  3101. end;
  3102.  
  3103. procedure TMainMenu.SetOle2MenuHandle(Handle: HMENU);
  3104. begin
  3105.   FOle2Menu := Handle;
  3106.   ItemChanged;
  3107. end;
  3108.  
  3109. { TPopupList }
  3110.  
  3111. procedure TPopupList.MainWndProc(var Message: TMessage);
  3112. begin
  3113.   try
  3114.     WndProc(Message);
  3115.   except
  3116.     Application.HandleException(Self);
  3117.   end;
  3118. end;
  3119.  
  3120. procedure TPopupList.WndProc(var Message: TMessage);
  3121. var
  3122.   I, Item: Integer;
  3123.   MenuItem: TMenuItem;
  3124.   FindKind: TFindItemKind;
  3125.   ContextID: Integer;
  3126.   Canvas: TCanvas;
  3127.   SaveIndex: Integer;
  3128.   DC: HDC;
  3129. begin
  3130.   case Message.Msg of
  3131.     WM_COMMAND:
  3132.       for I := 0 to Count - 1 do
  3133.         if TPopupMenu(Items[I]).DispatchCommand(Message.wParam) then Exit;
  3134.     WM_INITMENUPOPUP:
  3135.       for I := 0 to Count - 1 do
  3136.         with TWMInitMenuPopup(Message) do
  3137.           if TPopupMenu(Items[I]).DispatchPopup(MenuPopup) then Exit;
  3138.     WM_MENUSELECT:
  3139.       with TWMMenuSelect(Message) do
  3140.       begin
  3141.         FindKind := fkCommand;
  3142.         if MenuFlag and MF_POPUP <> 0 then FindKind := fkHandle;
  3143.         for I := 0 to Count - 1 do
  3144.         begin
  3145.           if FindKind = fkHandle then
  3146.           begin
  3147.             if Menu <> 0 then
  3148.               Item := GetSubMenu(Menu, IDItem) else
  3149.               Item := -1;
  3150.           end
  3151.           else
  3152.             Item := IDItem;
  3153.           MenuItem := TPopupMenu(Items[I]).FindItem(Item, FindKind);
  3154.           if MenuItem <> nil then
  3155.           begin
  3156.             Application.Hint := GetLongHint(MenuItem.Hint);
  3157.             Exit;
  3158.           end;
  3159.         end;
  3160.         Application.Hint := '';
  3161.       end;
  3162.     WM_HELP:
  3163.       with PHelpInfo(Message.LParam)^ do
  3164.       begin
  3165.         for I := 0 to Count - 1 do
  3166.         begin
  3167.           if hItemHandle = TMenu(Items[I]).Handle then
  3168.             MenuItem := TMenu(Items[I]).Items
  3169.           else
  3170.             MenuItem := TPopupMenu(Items[I]).FindItem(hItemHandle, fkHandle);
  3171.           if MenuItem <> nil then
  3172.           begin
  3173.             ContextID := TMenu(Items[I]).GetHelpContext(iCtrlID, True);
  3174.             if ContextID = 0 then
  3175.               ContextID := TMenu(Items[I]).GetHelpContext(hItemHandle, False);
  3176.             if Screen.ActiveForm = nil then Exit;
  3177.             if (ContextID = 0) then
  3178.               ContextID := Screen.ActiveForm.HelpContext;
  3179.             if (biHelp in Screen.ActiveForm.BorderIcons) then
  3180.               Application.HelpCommand(HELP_CONTEXTPOPUP, ContextID)
  3181.             else
  3182.               Application.HelpContext(ContextID);
  3183.             Exit;
  3184.           end;
  3185.         end;
  3186.       end;
  3187.     WM_DRAWITEM:
  3188.       with PDrawItemStruct(Message.LParam)^ do
  3189.       begin
  3190.         for I := 0 to Count - 1 do
  3191.         begin
  3192.           MenuItem := TPopupMenu(Items[I]).FindItem(itemID, fkCommand);
  3193.           if MenuItem <> nil then
  3194.           begin
  3195.             Canvas := TControlCanvas.Create;
  3196.             with Canvas do
  3197.             try
  3198.               SaveIndex := SaveDC(hDC);
  3199.               try
  3200.                 Handle := hDC;
  3201.                 Font := Screen.MenuFont;
  3202.                 DrawMenuItem(MenuItem, Canvas, rcItem, TOwnerDrawState(LongRec(itemState).Lo));
  3203.               finally
  3204.                 Handle := 0;
  3205.                 RestoreDC(hDC, SaveIndex);
  3206.               end;
  3207.             finally
  3208.               Canvas.Free;
  3209.             end;
  3210.             Exit;
  3211.           end;
  3212.         end;
  3213.       end;
  3214.     WM_MEASUREITEM:
  3215.       with PMeasureItemStruct(Message.LParam)^ do
  3216.       begin
  3217.         for I := 0 to Count - 1 do
  3218.         begin
  3219.           MenuItem := TPopupMenu(Items[I]).FindItem(itemID, fkCommand);
  3220.           if MenuItem <> nil then
  3221.           begin
  3222.             DC := GetWindowDC(Window);
  3223.             try
  3224.               Canvas := TControlCanvas.Create;
  3225.               with Canvas do
  3226.               try
  3227.                 SaveIndex := SaveDC(DC);
  3228.                 try
  3229.                   Handle := DC;
  3230.                   Font := Screen.MenuFont;
  3231.                   MenuItem.MeasureItem(Canvas, Integer(itemWidth),
  3232.                     Integer(itemHeight));
  3233.                 finally
  3234.                   Handle := 0;
  3235.                   RestoreDC(DC, SaveIndex);
  3236.                 end;
  3237.               finally
  3238.                 Canvas.Free;
  3239.               end;
  3240.             finally
  3241.               ReleaseDC(Window, DC);
  3242.             end;
  3243.             Exit;
  3244.           end;
  3245.         end;
  3246.       end;
  3247.     WM_MENUCHAR:
  3248.       for I := 0 to Count - 1 do
  3249.         with TPopupMenu(Items[I]) do
  3250.           if (Handle = HMENU(Message.LParam)) or
  3251.             (FindItem(Message.LParam, fkHandle) <> nil) then
  3252.           begin
  3253.             ProcessMenuChar(TWMMenuChar(Message));
  3254.             Exit;
  3255.           end;
  3256.   end;
  3257.   with Message do Result := DefWindowProc(Window, Msg, wParam, lParam);
  3258. end;
  3259.  
  3260. procedure TPopupList.Add(Popup: TPopupMenu);
  3261. begin
  3262.   if Count = 0 then FWindow := AllocateHWnd(MainWndProc);
  3263.   inherited Add(Popup);
  3264. end;
  3265.  
  3266. procedure TPopupList.Remove(Popup: TPopupMenu);
  3267. begin
  3268.   inherited Remove(Popup);
  3269.   if Count = 0 then DeallocateHWnd(FWindow);
  3270. end;
  3271.  
  3272. { TPopupMenu }
  3273.  
  3274. constructor TPopupMenu.Create(AOwner: TComponent);
  3275. begin
  3276.   inherited Create(AOwner);
  3277.   FPopupPoint.X := -1;
  3278.   FPopupPoint.Y := -1;
  3279.   FItems.OnClick := DoPopup;
  3280.   FWindowHandle := Application.Handle;
  3281.   FAutoPopup := True;
  3282.   PopupList.Add(Self);
  3283. end;
  3284.  
  3285. destructor TPopupMenu.Destroy;
  3286. begin
  3287.   PopupList.Remove(Self);
  3288.   inherited Destroy;
  3289. end;
  3290.  
  3291. procedure TPopupMenu.DoPopup(Sender: TObject);
  3292. begin
  3293.   if Assigned(FOnPopup) then FOnPopup(Sender);
  3294. end;
  3295.  
  3296. function TPopupMenu.GetHelpContext: THelpContext;
  3297. begin
  3298.   Result := FItems.HelpContext;
  3299. end;
  3300.  
  3301. procedure TPopupMenu.SetHelpContext(Value: THelpContext);
  3302. begin
  3303.   FItems.HelpContext := Value;
  3304. end;
  3305.  
  3306. procedure TPopupMenu.SetBiDiModeFromPopupControl;
  3307. var
  3308.   AControl: TControl;
  3309. begin
  3310.   if not SysLocale.MiddleEast then Exit;
  3311.   if FParentBiDiMode then
  3312.   begin
  3313.     { Use the setting from the control that activated the popup.
  3314.       If there is no control, then use Application }
  3315.     AControl := FindPopupControl(FPopupPoint);
  3316.     if AControl <> nil then
  3317.     begin
  3318.       BiDiMode := AControl.BiDiMode;
  3319.       FParentBiDiMode := True;
  3320.     end
  3321.     else
  3322.     begin
  3323.       BiDiMode := Application.BiDiMode;
  3324.       FParentBiDiMode := True;
  3325.     end;
  3326.   end;
  3327. end;
  3328.  
  3329. function TPopupMenu.UseRightToLeftAlignment: Boolean;
  3330. var
  3331.   AControl: TControl;
  3332. begin
  3333.   Result := False;
  3334.   if not SysLocale.MiddleEast then Exit;
  3335.   if FParentBiDiMode then
  3336.   begin
  3337.     { Use the setting from the control that activated the popup.
  3338.       If there is no control, then use Application }
  3339.     AControl := FindPopupControl(FPopupPoint);
  3340.     if AControl <> nil then
  3341.       Result := AControl.UseRightToLeftAlignment
  3342.     else
  3343.       Result := Application.UseRightToLeftAlignment;
  3344.   end
  3345.   else
  3346.     Result := (FBiDiMode = bdRightToLeft);
  3347. end;
  3348.  
  3349. procedure TPopupMenu.Popup(X, Y: Integer);
  3350. const
  3351.   Flags: array[Boolean, TPopupAlignment] of Word =
  3352.     ((TPM_LEFTALIGN, TPM_RIGHTALIGN, TPM_CENTERALIGN),
  3353.      (TPM_RIGHTALIGN, TPM_LEFTALIGN, TPM_CENTERALIGN));
  3354.   Buttons: array[TTrackButton] of Word = (TPM_RIGHTBUTTON, TPM_LEFTBUTTON);
  3355. var
  3356.   AFlags: Integer;
  3357. begin
  3358.   FPopupPoint := Point(X, Y);
  3359.   SetBiDiModeFromPopupControl;
  3360.   DoPopup(Self);
  3361.   FItems.InternalRethinkHotkeys(False);
  3362.   FItems.InternalRethinkLines(False);
  3363.   FItems.RebuildHandle;
  3364.   AdjustBiDiBehavior;
  3365.   AFlags := Flags[UseRightToLeftAlignment, FAlignment] or Buttons[FTrackButton] or
  3366.     (Byte(FMenuAnimation) shl 10);
  3367.   TrackPopupMenu(FItems.Handle, AFlags, X, Y, 0 { reserved }, PopupList.Window, nil);
  3368. end;
  3369.  
  3370. { TMenuItemStack }
  3371.  
  3372. procedure TMenuItemStack.ClearItem(AItem: TMenuItem);
  3373. var
  3374.   I: Integer;
  3375. begin
  3376.   for I := 0 to List.Count - 1 do
  3377.     if PMenuItem(List[I])^ = AItem then
  3378.       PMenuItem(List[I])^ := nil;
  3379. end;
  3380.  
  3381. { Menu building functions }
  3382.  
  3383. procedure InitMenuItems(AMenu: TMenu; Items: array of TMenuItem);
  3384. var
  3385.   I: Integer;
  3386.  
  3387.   procedure SetOwner(Item: TMenuItem);
  3388.   var
  3389.     I: Integer;
  3390.   begin
  3391.     if Item.Owner = nil then AMenu.Owner.InsertComponent(Item);
  3392.     for I := 0 to Item.Count - 1 do
  3393.       SetOwner(Item[I]);
  3394.   end;
  3395.  
  3396. begin
  3397.   for I := Low(Items) to High(Items) do
  3398.   begin
  3399.     SetOwner(Items[I]);
  3400.     AMenu.FItems.Add(Items[I]);
  3401.   end;
  3402. end;
  3403.  
  3404. function NewMenu(Owner: TComponent; const AName: string; Items: array of TMenuItem): TMainMenu;
  3405. begin
  3406.   Result := TMainMenu.Create(Owner);
  3407.   Result.Name := AName;
  3408.   InitMenuItems(Result, Items);
  3409. end;
  3410.  
  3411. function NewPopupMenu(Owner: TComponent; const AName: string;
  3412.   Alignment: TPopupAlignment; AutoPopup: Boolean; Items: array of TMenuItem): TPopupMenu;
  3413. begin
  3414.   Result := TPopupMenu.Create(Owner);
  3415.   Result.Name := AName;
  3416.   Result.AutoPopup := AutoPopup;
  3417.   Result.Alignment := Alignment;
  3418.   InitMenuItems(Result, Items);
  3419. end;
  3420.  
  3421. function NewSubMenu(const ACaption: string; hCtx: Word;
  3422.   const AName: string; Items: array of TMenuItem; AEnabled: Boolean): TMenuItem;
  3423. var
  3424.   I: Integer;
  3425. begin
  3426.   Result := TMenuItem.Create(nil);
  3427.   for I := Low(Items) to High(Items) do
  3428.     Result.Add(Items[I]);
  3429.   Result.Caption := ACaption;
  3430.   Result.HelpContext := hCtx;
  3431.   Result.Name := AName;
  3432.   Result.Enabled := AEnabled;
  3433. end;
  3434.  
  3435. function NewItem(const ACaption: string; AShortCut: TShortCut;
  3436.   AChecked, AEnabled: Boolean; AOnClick: TNotifyEvent; hCtx: Word;
  3437.   const AName: string): TMenuItem;
  3438. begin
  3439.   Result := TMenuItem.Create(nil);
  3440.   with Result do
  3441.   begin
  3442.     Caption := ACaption;
  3443.     ShortCut := AShortCut;
  3444.     OnClick := AOnClick;
  3445.     HelpContext := hCtx;
  3446.     Checked := AChecked;
  3447.     Enabled := AEnabled;
  3448.     Name := AName;
  3449.   end;
  3450. end;
  3451.  
  3452. function NewLine: TMenuItem;
  3453. begin
  3454.   Result := TMenuItem.Create(nil);
  3455.   Result.Caption := cLineCaption;
  3456. end;
  3457.  
  3458. procedure DrawMenuItem(MenuItem: TMenuItem; ACanvas: TCanvas; ARect: TRect;
  3459.   State: TOwnerDrawState);
  3460. var
  3461.   TopLevel: Boolean;
  3462.   Win98Plus: Boolean;
  3463. begin
  3464.   with ACanvas do
  3465.   begin
  3466.     Win98Plus := (Win32MajorVersion > 4) or
  3467.       ((Win32MajorVersion = 4) and (Win32MinorVersion > 0));
  3468.     TopLevel := MenuItem.GetParentComponent is TMainMenu;
  3469.     if (odSelected in State) and (not TopLevel or (TopLevel and not Win98Plus)) then
  3470.     begin
  3471.       Brush.Color := clHighlight;
  3472.       Font.Color := clHighlightText;
  3473.     end
  3474.     else if Win98Plus and (odInactive in State) then
  3475.     begin
  3476.       Brush.Color := clMenu;
  3477.       Font.Color := clGrayText;
  3478.     end
  3479.     else
  3480.     begin
  3481.       Brush.Color := clMenu;
  3482.       Font.Color := clMenuText;
  3483.     end;
  3484.     MenuItem.AdvancedDrawItem(ACanvas, ARect, State, TopLevel);
  3485.   end;
  3486. end;
  3487.  
  3488. function StripHotkey(const Text: string): string;
  3489. var
  3490.   I: Integer;
  3491. begin
  3492.   Result := Text;
  3493.   I := 1;
  3494.   while I <= Length(Result) do
  3495.   begin
  3496.     if Result[I] in LeadBytes then
  3497.       Inc(I)
  3498.     else if Result[I] = cHotkeyPrefix then
  3499.       if SysLocale.FarEast and
  3500.         ((I > 1) and (Length(Result)-I >= 2) and
  3501.          (Result[I-1] = '(') and (Result[I+2] = ')')) then
  3502.         Delete(Result, I-1, 4)
  3503.       else
  3504.         Delete(Result, I, 1);
  3505.     Inc(I);
  3506.   end;
  3507. end;
  3508.  
  3509. function GetHotkey(const Text: string): string;
  3510. var
  3511.   I, L: Integer;
  3512. begin
  3513.   Result := '';
  3514.   I := 1;
  3515.   L := Length(Text);
  3516.   while I <= L do
  3517.   begin
  3518.     if Text[I] in LeadBytes then
  3519.       Inc(I)
  3520.     else if (Text[I] = cHotkeyPrefix) and
  3521.             (L - I >= 1) then
  3522.     begin
  3523.       Inc(I);
  3524.       if Text[I] <> cHotkeyPrefix then
  3525.         Result := Text[I]; // keep going there may be another one
  3526.     end;
  3527.     Inc(I);
  3528.   end;
  3529. end;
  3530.  
  3531. function AnsiSameCaption(const Text1, Text2: string): Boolean;
  3532. begin
  3533.   Result := AnsiSameText(StripHotkey(Text1), StripHotkey(Text2));
  3534. end;
  3535.  
  3536. initialization
  3537.   RegisterClasses([TMenuItem]);
  3538.   CommandPool := TBits.Create;
  3539.   PopupList := TPopupList.Create;
  3540.   ShortCutItems := TMenuItemStack.Create;
  3541. finalization
  3542.   ShortCutItems.Free;
  3543.   PopupList.Free;
  3544.   CommandPool.Free;
  3545. end.
  3546.  
  3547.