1{
2 /***************************************************************************
3                                     menus.pp
4                                     --------
5                   Component Library TMenu, TMenuItem Controls
6                   Initial Revision  : Mon Jul 26 0:10:12 1999
7
8
9 ***************************************************************************/
10
11 *****************************************************************************
12  This file is part of the Lazarus Component Library (LCL)
13
14  See the file COPYING.modifiedLGPL.txt, included in this distribution,
15  for details about the license.
16 *****************************************************************************
17}
18
19{
20TMenu, TMenuItem
21@author(TMenu - Shane Miller <smiller@lakefield.net>)
22@author(TMenuItem - Shane Miller <smiller@lakefield.net>)
23@author(TMainMenu - Marc Weustink <weus@quicknet.nl>)
24@author(TPopupMenu - Marc Weustink <weus@quicknet.nl>
25@created(26-Jul-1999)
26@lastmod(27-Oct-1999)
27
28Detailed description of the Unit.
29}
30unit Menus;
31
32{$mode objfpc}{$H+}
33
34interface
35
36{$ifdef Trace}
37{$ASSERTIONS ON}
38{$endif}
39
40uses
41  Types, Classes, SysUtils,
42  // LCL
43  LCLStrConsts, LCLType, LCLProc, LCLIntf, LCLClasses, LResources, LMessages,
44  ActnList, Graphics, ImgList, Themes,
45  // LazUtils
46  LazMethodList, LazLoggerBase;
47
48type
49  TMenu = class;
50  TMenuItem = class;
51  EMenuError = class(Exception);
52
53  TGlyphShowMode = (
54    gsmAlways,       // always show
55    gsmNever,        // never show
56    gsmApplication,  // depends on application settings
57    gsmSystem        // depends on system settings
58  );
59
60  TMenuChangeEvent = procedure (Sender: TObject; Source: TMenuItem;
61                                Rebuild: Boolean) of object;
62
63  { TMenuActionLink }
64
65  TMenuActionLink = class(TActionLink)
66  protected
67    FClient: TMenuItem;
68    procedure AssignClient(AClient: TObject); override;
69    function IsAutoCheckLinked: Boolean; virtual;
70  protected
71    function IsOnExecuteLinked: Boolean; override;
72    procedure SetAutoCheck(Value: Boolean); override;
73    procedure SetCaption(const Value: string); override;
74    procedure SetChecked(Value: Boolean); override;
75    procedure SetEnabled(Value: Boolean); override;
76    procedure SetHelpContext(Value: THelpContext); override;
77    procedure SetHint(const Value: string); override;
78    procedure SetImageIndex(Value: Integer); override;
79    procedure SetShortCut(Value: TShortCut); override;
80    procedure SetVisible(Value: Boolean); override;
81    procedure SetOnExecute(Value: TNotifyEvent); override;
82  public
83    function IsCaptionLinked: Boolean; override;
84    function IsCheckedLinked: Boolean; override;
85    function IsEnabledLinked: Boolean; override;
86    function IsHelpContextLinked: Boolean; override;
87    function IsHintLinked: Boolean; override;
88    function IsGroupIndexLinked: Boolean; override;
89    function IsImageIndexLinked: Boolean; override;
90    function IsShortCutLinked: Boolean; override;
91    function IsVisibleLinked: Boolean; override;
92  end;
93
94  TMenuActionLinkClass = class of TMenuActionLink;
95
96  { TMenuItemEnumerator }
97
98  TMenuItemEnumerator = class
99  private
100    FMenuItem: TMenuItem;
101    FPosition: Integer;
102    function GetCurrent: TMenuItem;
103  public
104    constructor Create(AMenuItem: TMenuItem);
105    function MoveNext: Boolean;
106    property Current: TMenuItem read GetCurrent;
107  end;
108
109  { TMenuItem }
110
111  TMenuItemHandlerType = (
112    mihtDestroy
113    );
114
115  TMenuDrawItemEvent = procedure(Sender: TObject; ACanvas: TCanvas;
116    ARect: TRect; AState: TOwnerDrawState) of object;
117  TMenuMeasureItemEvent = procedure(Sender: TObject; ACanvas: TCanvas;
118    var AWidth, AHeight: Integer) of object;
119
120  TMenuItem = class(TLCLComponent)
121  private
122    FActionLink: TMenuActionLink;
123    FCaption: TTranslateString;
124    FBitmap: TBitmap;
125    FGlyphShowMode: TGlyphShowMode;
126    FHandle: HMenu;
127    FHelpContext: THelpContext;
128    FHint: String;
129    FImageChangeLink: TChangeLink;
130    FImageIndex: TImageIndex;
131    FItems: TList; // list of TMenuItem
132    FMenu: TMenu;
133    FOnChange: TMenuChangeEvent;
134    FOnClick: TNotifyEvent;
135    FOnDrawItem: TMenuDrawItemEvent;
136    FOnMeasureItem: TMenuMeasureItemEvent;
137    FParent: TMenuItem;
138    FMenuItemHandlers: array[TMenuItemHandlerType] of TMethodList;
139    FSubMenuImages: TCustomImageList;
140    FSubMenuImagesWidth: Integer;
141    FShortCut: TShortCut;
142    FShortCutKey2: TShortCut;
143    FGroupIndex: Byte;
144    FRadioItem: Boolean;
145    FRightJustify: boolean;
146    FShowAlwaysCheckable: boolean;
147    FVisible: Boolean;
148    // True => Bitmap property indicates assigned Bitmap.
149    // False => Bitmap property is not assigned but can represent imagelist bitmap
150    FBitmapIsValid: Boolean;
151    FAutoCheck: Boolean;
152    FChecked: Boolean;
153    FDefault: Boolean;
154    FEnabled: Boolean;
155    function GetBitmap: TBitmap;
156    function GetCount: Integer;
157    function GetItem(Index: Integer): TMenuItem;
158    function GetMenuIndex: Integer;
159    function GetParent: TMenuItem;
160    function IsBitmapStored: boolean;
161    function IsCaptionStored: boolean;
162    function IsCheckedStored: boolean;
163    function IsEnabledStored: boolean;
164    function IsHelpContextStored: boolean;
165    function IsHintStored: Boolean;
166    function IsImageIndexStored: Boolean;
167    function IsShortCutStored: boolean;
168    function IsVisibleStored: boolean;
169    procedure SetAutoCheck(const AValue: boolean);
170    procedure SetCaption(const AValue: TTranslateString);
171    procedure SetChecked(AValue: Boolean);
172    procedure SetDefault(AValue: Boolean);
173    procedure SetEnabled(AValue: Boolean);
174    procedure SetBitmap(const AValue: TBitmap);
175    procedure SetGlyphShowMode(const AValue: TGlyphShowMode);
176    procedure SetMenuIndex(AValue: Integer);
177    procedure SetName(const Value: TComponentName); override;
178    procedure SetRadioItem(const AValue: Boolean);
179    procedure SetRightJustify(const AValue: boolean);
180    procedure SetShowAlwaysCheckable(const AValue: boolean);
181    procedure SetSubMenuImages(const AValue: TCustomImageList);
182    procedure SetSubMenuImagesWidth(const aSubMenuImagesWidth: Integer);
183    procedure ShortcutChanged;
184    procedure SubItemChanged(Sender: TObject; Source: TMenuItem; Rebuild: Boolean);
185    procedure TurnSiblingsOff;
186    procedure DoActionChange(Sender: TObject);
187  protected
188    FCommand: Word;
189    class procedure WSRegisterClass; override;
190    procedure ActionChange(Sender: TObject; CheckDefaults: Boolean); virtual;
191    procedure AssignTo(Dest: TPersistent); override;
192    procedure BitmapChange(Sender: TObject);
193    function DoDrawItem(ACanvas: TCanvas; ARect: TRect; AState: TOwnerDrawState): Boolean; virtual;
194    function DoMeasureItem(ACanvas: TCanvas; var AWidth, AHeight: Integer): Boolean; virtual;
195    function GetAction: TBasicAction;
196    function GetActionLinkClass: TMenuActionLinkClass; virtual;
197    function GetHandle: HMenu;
198    procedure DoClicked(var msg); message LM_ACTIVATE;
199    procedure CheckChildrenHandles;
200    procedure CreateHandle; virtual;
201    procedure DestroyHandle; virtual;
202    procedure Loaded; override;
203    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
204    procedure GetChildren(Proc: TGetChildProc; Root: TComponent); override;
205    procedure InitiateActions;
206    procedure MenuChanged(Rebuild : Boolean);
207    procedure SetAction(NewAction: TBasicAction);
208    procedure SetChildOrder(Child: TComponent; Order: Integer); override;
209    procedure SetGroupIndex(AValue: Byte);
210    procedure SetImageIndex(AValue : TImageIndex);
211    procedure SetParentComponent(AValue : TComponent); override;
212    procedure SetShortCut(const AValue : TShortCut);
213    procedure SetShortCutKey2(const AValue : TShortCut);
214    procedure SetVisible(AValue: Boolean);
215    procedure UpdateImage;
216    procedure UpdateImages;
217    procedure UpdateWSIcon;
218    procedure ImageListChange(Sender: TObject);
219  protected
220    property ActionLink: TMenuActionLink read FActionLink write FActionLink;
221  public
222    FCompStyle: LongInt;
223    constructor Create(TheOwner: TComponent); override;
224    destructor Destroy; override;
225    function Find(const ACaption: string): TMenuItem;
226    function GetEnumerator: TMenuItemEnumerator;
227    procedure GetImageList(out aImages: TCustomImageList; out aImagesWidth: Integer); virtual;
228    function GetImageList: TCustomImageList;
229    function GetParentComponent: TComponent; override;
230    function GetParentMenu: TMenu; virtual;
231    function GetIsRightToLeft:Boolean; virtual;
232    function HandleAllocated : Boolean;
233    function HasIcon: boolean; virtual;
234    function HasParent: Boolean; override;
235    procedure InitiateAction; virtual;
236    procedure IntfDoSelect; virtual;
237    function IndexOf(Item: TMenuItem): Integer;
238    function IndexOfCaption(const ACaption: string): Integer; virtual;
239    function VisibleIndexOf(Item: TMenuItem): Integer;
240    procedure Add(Item: TMenuItem);
241    procedure Add(const AItems: array of TMenuItem);
242    procedure AddSeparator;
243    procedure Click; virtual;
244    procedure Delete(Index: Integer);
245    procedure HandleNeeded; virtual;
246    procedure Insert(Index: Integer; Item: TMenuItem);
247    procedure RecreateHandle; virtual;
248    procedure Remove(Item: TMenuItem);
249    function IsCheckItem: boolean; virtual;
250    function IsLine: Boolean;
251    function IsInMenuBar: boolean; virtual;
252    procedure Clear;
253    function HasBitmap: boolean;
254    function GetIconSize(ADC: HDC): TPoint; virtual;
255    // Event lists
256    procedure RemoveAllHandlersOfObject(AnObject: TObject); override;
257    procedure AddHandlerOnDestroy(const OnDestroyEvent: TNotifyEvent;
258                                  AsFirst: boolean = false);
259    procedure RemoveHandlerOnDestroy(const OnDestroyEvent: TNotifyEvent);
260    procedure AddHandler(HandlerType: TMenuItemHandlerType;
261                         const AMethod: TMethod; AsFirst: boolean = false);
262    procedure RemoveHandler(HandlerType: TMenuItemHandlerType;
263                            const AMethod: TMethod);
264  public
265    property Count: Integer read GetCount;
266    property Handle: HMenu read GetHandle write FHandle;
267    property Items[Index: Integer]: TMenuItem read GetItem; default;
268    property MenuIndex: Integer read GetMenuIndex write SetMenuIndex;
269    property Menu: TMenu read FMenu;
270    property Parent: TMenuItem read GetParent;
271    property Command: Word read FCommand;
272    function MenuVisibleIndex: integer;
273    procedure WriteDebugReport(const Prefix: string);
274  published
275    property Action: TBasicAction read GetAction write SetAction;
276    property AutoCheck: boolean read FAutoCheck write SetAutoCheck default False;
277    property Caption: TTranslateString read FCaption write SetCaption
278                             stored IsCaptionStored;
279    property Checked: Boolean read FChecked write SetChecked
280                              stored IsCheckedStored default False;
281    property Default: Boolean read FDefault write SetDefault default False;
282    property Enabled: Boolean read FEnabled write SetEnabled
283                              stored IsEnabledStored default True;
284    property Bitmap: TBitmap read GetBitmap write SetBitmap stored IsBitmapStored;
285    property GroupIndex: Byte read FGroupIndex write SetGroupIndex default 0;
286    property GlyphShowMode: TGlyphShowMode read FGlyphShowMode write SetGlyphShowMode default gsmApplication;
287    property HelpContext: THelpContext read FHelpContext write FHelpContext
288                                           stored IsHelpContextStored default 0;
289    property Hint: TTranslateString read FHint write FHint stored IsHintStored;
290    property ImageIndex: TImageIndex read FImageIndex write SetImageIndex
291                                           stored IsImageIndexStored default -1;
292    property RadioItem: Boolean read FRadioItem write SetRadioItem default False;
293    property RightJustify: boolean read FRightJustify write SetRightJustify default False;
294    property ShortCut: TShortCut read FShortCut write SetShortCut
295                                 stored IsShortCutStored default 0;
296    property ShortCutKey2: TShortCut read FShortCutKey2 write SetShortCutKey2 default 0;
297    property ShowAlwaysCheckable: boolean read FShowAlwaysCheckable
298                                 write SetShowAlwaysCheckable default False;
299    property SubMenuImages: TCustomImageList read FSubMenuImages write SetSubMenuImages;
300    property SubMenuImagesWidth: Integer read FSubMenuImagesWidth write SetSubMenuImagesWidth default 0;
301    property Visible: Boolean read FVisible write SetVisible
302                              stored IsVisibleStored default True;
303    property OnClick: TNotifyEvent read FOnClick write FOnClick;
304    property OnDrawItem: TMenuDrawItemEvent read FOnDrawItem write FOnDrawItem;
305    property OnMeasureItem: TMenuMeasureItemEvent read FOnMeasureItem write FOnMeasureItem;
306  end;
307  TMenuItemClass = class of TMenuItem;
308
309
310  { TMenu }
311
312  TFindItemKind = (fkCommand, fkHandle, fkShortCut);
313
314  TMenu = class(TLCLComponent)
315  private
316    FBiDiMode: TBiDiMode;
317    FImageChangeLink: TChangeLink;
318    FImages: TCustomImageList;
319    FImagesWidth: Integer;
320    FItems: TMenuItem;
321    FOnDrawItem: TMenuDrawItemEvent;
322    FOnChange: TMenuChangeEvent;
323    FOnMeasureItem: TMenuMeasureItemEvent;
324    FOwnerDraw: Boolean;
325    FParent: TComponent;
326    FParentBiDiMode: Boolean;
327    FShortcutHandled: boolean;
328//See TCustomForm.CMBiDiModeChanged
329    procedure CMParentBiDiModeChanged(var Message: TLMessage); message CM_PARENTBIDIMODECHANGED;
330    procedure CMAppShowMenuGlyphChanged(var Message: TLMessage); message CM_APPSHOWMENUGLYPHCHANGED;
331    function IsBiDiModeStored: Boolean;
332    procedure ImageListChange(Sender: TObject);
333    procedure SetBiDiMode(const AValue: TBiDiMode);
334    procedure SetImages(const AValue: TCustomImageList);
335    procedure SetImagesWidth(const aImagesWidth: Integer);
336    procedure SetParent(const AValue: TComponent);
337    procedure SetParentBiDiMode(const AValue: Boolean);
338  protected
339    class procedure WSRegisterClass; override;
340    procedure BidiModeChanged; virtual;
341    procedure CreateHandle; virtual;
342    procedure DoChange(Source: TMenuItem; Rebuild: Boolean); virtual;
343    function GetHandle: HMENU; virtual;
344    procedure GetChildren(Proc: TGetChildProc; Root: TComponent); override;
345    procedure MenuChanged(Sender: TObject; Source: TMenuItem;
346                          Rebuild: Boolean); virtual;
347    procedure AssignTo(Dest: TPersistent); override;
348    procedure Notification(AComponent: TComponent;
349      Operation: TOperation); override;
350    procedure ParentBidiModeChanged;
351    procedure ParentBidiModeChanged(AOwner:TComponent);//used in Create constructor
352    procedure SetChildOrder(Child: TComponent; Order: Integer); override;
353    procedure UpdateItems;
354
355    property OnChange: TMenuChangeEvent read FOnChange write FOnChange;
356  public
357    FCompStyle: LongInt;
358    constructor Create(AOwner: TComponent); override;
359    destructor Destroy; override;
360    procedure DestroyHandle; virtual;
361    function FindItem(AValue: PtrInt; Kind: TFindItemKind): TMenuItem;
362    function GetHelpContext(AValue: PtrInt; ByCommand: Boolean): THelpContext;
363    function IsShortcut(var Message: TLMKey): boolean;
364    function HandleAllocated: Boolean;
365    function IsRightToLeft: Boolean; virtual;
366    function UseRightToLeftAlignment: Boolean; virtual;
367    function UseRightToLeftReading: Boolean; virtual;
368    procedure HandleNeeded;
369    function DispatchCommand(ACommand: Word): Boolean;
370  public
371    property Handle: HMenu read GetHandle;
372    property Parent: TComponent read FParent write SetParent;
373    property ShortcutHandled: boolean read FShortcutHandled write FShortcutHandled;
374  published
375    property BidiMode:TBidiMode read FBidiMode write SetBidiMode stored IsBiDiModeStored default bdLeftToRight;
376    property ParentBidiMode:Boolean read FParentBidiMode write SetParentBidiMode default True;
377    property Items: TMenuItem read FItems;
378    property Images: TCustomImageList read FImages write SetImages;
379    property ImagesWidth: Integer read FImagesWidth write SetImagesWidth default 0;
380    property OwnerDraw: Boolean read FOwnerDraw write FOwnerDraw default False;
381    property OnDrawItem: TMenuDrawItemEvent read FOnDrawItem write FOnDrawItem;
382    property OnMeasureItem: TMenuMeasureItemEvent read FOnMeasureItem write FOnMeasureItem;
383  end;
384
385
386  { TMainMenu }
387
388  TMainMenu = class(TMenu)
389  private
390    FWindowHandle: HWND;
391    function GetHeight: Integer;
392    procedure SetWindowHandle(const AValue: HWND);
393  protected
394    procedure ItemChanged;
395    class procedure WSRegisterClass; override;
396    procedure MenuChanged(Sender: TObject; Source: TMenuItem; Rebuild: Boolean); override;
397  public
398    constructor Create(AOwner: TComponent); override;
399    property Height: Integer read GetHeight;
400    property WindowHandle: HWND read FWindowHandle write SetWindowHandle;
401  published
402    property OnChange;
403  end;
404
405
406  { TPopupMenu }
407
408  TPopupAlignment = (paLeft, paRight, paCenter);
409  TTrackButton = (tbRightButton, tbLeftButton);
410
411  TPopupMenu = class(TMenu)
412  private
413    FAlignment: TPopupAlignment;
414    FAutoPopup: Boolean;
415    FOnClose: TNotifyEvent;
416    FOnPopup: TNotifyEvent;
417    FPopupComponent: TComponent;
418    FPopupPoint: TPoint;
419    FTrackButton: TTrackButton;
420    function GetHelpContext: THelpContext;
421    procedure SetHelpContext(const AValue: THelpContext);
422  protected
423    class procedure WSRegisterClass; override;
424    procedure DoPopup(Sender: TObject); virtual;
425    procedure DoClose; virtual;
426  public
427    constructor Create(AOwner: TComponent); override;
428    destructor Destroy; override;
429    procedure PopUp;
430    procedure PopUp(X, Y: Integer); virtual;
431    property PopupComponent: TComponent read FPopupComponent write FPopupComponent;
432    property PopupPoint: TPoint read FPopupPoint;
433    procedure Close;
434  published
435    property Alignment: TPopupAlignment read FAlignment write FAlignment default paLeft;
436    property AutoPopup: Boolean read FAutoPopup write FAutoPopup default True;
437    property HelpContext: THelpContext read GetHelpContext write SetHelpContext default 0;
438    property TrackButton: TTrackButton read FTrackButton write FTrackButton default tbRightButton;
439    property OnPopup: TNotifyEvent read FOnPopup write FOnPopup;
440    property OnClose: TNotifyEvent read FOnClose write FOnClose;
441  end;
442
443function ShortCut(const Key: Word; const Shift : TShiftState) : TShortCut;
444procedure ShortCutToKey(const ShortCut : TShortCut; out Key: Word;
445                        out Shift : TShiftState);
446
447var
448  DesignerMenuItemClick: TNotifyEvent = nil;
449  ActivePopupMenu: TPopupMenu = nil;
450  OnMenuPopupHandler: TNotifyEvent = nil;
451
452function NewMenu(Owner: TComponent; const AName: string;
453                 const Items: array of TMenuItem): TMainMenu;
454function NewPopupMenu(Owner: TComponent; const AName: string;
455                      Alignment: TPopupAlignment; AutoPopup: Boolean;
456                      const Items: array of TMenuItem): TPopupMenu;
457function NewSubMenu(const ACaption: string; hCtx: THelpContext;
458                    const AName: string; const Items: array of TMenuItem;
459                    TheEnabled: Boolean = True): TMenuItem;
460function NewItem(const ACaption: string; AShortCut: TShortCut;
461                 AChecked, TheEnabled: Boolean; TheOnClick: TNotifyEvent;
462                 hCtx: THelpContext; const AName: string): TMenuItem;
463function NewLine: TMenuItem;
464
465function StripHotkey(const Text: string): string;
466
467procedure Register;
468
469
470const
471  cHotkeyPrefix   = '&';
472  cLineCaption    = '-';
473  cDialogSuffix   = '...';
474
475  ValidMenuHotkeys: string = '1234567890ABCDEFGHIJKLMNOPQRSTUVWXYZ';
476
477
478
479implementation
480
481uses
482  WSMenus,
483  Forms {KeyDataToShiftState};
484
485{ Helpers for Assign() }
486
487procedure MenuItem_Copy(ASrc, ADest: TMenuItem);
488var
489  mi: TMenuItem;
490  i: integer;
491begin
492  ADest.Clear;
493  ADest.Action:= ASrc.Action;
494  ADest.AutoCheck:= ASrc.AutoCheck;
495  ADest.Caption:= ASrc.Caption;
496  ADest.Checked:= ASrc.Checked;
497  ADest.Default:= ASrc.Default;
498  ADest.Enabled:= ASrc.Enabled;
499  ADest.Bitmap:= ASrc.Bitmap;
500  ADest.GroupIndex:= ASrc.GroupIndex;
501  ADest.GlyphShowMode:= ASrc.GlyphShowMode;
502  ADest.HelpContext:= ASrc.HelpContext;
503  ADest.Hint:= ASrc.Hint;
504  ADest.ImageIndex:= ASrc.ImageIndex;
505  ADest.RadioItem:= ASrc.RadioItem;
506  ADest.RightJustify:= ASrc.RightJustify;
507  ADest.ShortCut:= ASrc.ShortCut;
508  ADest.ShortCutKey2:= ASrc.ShortCutKey2;
509  ADest.ShowAlwaysCheckable:= ASrc.ShowAlwaysCheckable;
510  ADest.SubMenuImages:= ASrc.SubMenuImages;
511  ADest.SubMenuImagesWidth:= ASrc.SubMenuImagesWidth;
512  ADest.Visible:= ASrc.Visible;
513  ADest.OnClick:= ASrc.OnClick;
514  ADest.OnDrawItem:= ASrc.OnDrawItem;
515  ADest.OnMeasureItem:= ASrc.OnMeasureItem;
516  ADest.Tag:= ASrc.Tag;
517
518  for i:= 0 to ASrc.Count-1 do
519  begin
520    mi:= TMenuItem.Create(ASrc.Owner);
521    MenuItem_Copy(ASrc.Items[i], mi);
522    ADest.Add(mi);
523  end;
524end;
525
526procedure Menu_Copy(ASrc, ADest: TMenu);
527begin
528  ADest.BidiMode:= ASrc.BidiMode;
529  ADest.ParentBidiMode:= ASrc.ParentBidiMode;
530  ADest.Images:= ASrc.Images;
531  ADest.ImagesWidth:= ASrc.ImagesWidth;
532  ADest.OwnerDraw:= ASrc.OwnerDraw;
533  ADest.OnDrawItem:= ASrc.OnDrawItem;
534  ADest.OnMeasureItem:= ASrc.OnMeasureItem;
535
536  MenuItem_Copy(ASrc.Items, ADest.Items);
537end;
538
539{ Easy Menu building }
540
541procedure AddMenuItems(AMenu: TMenu; const Items: array of TMenuItem);
542
543  procedure SetOwner(Item: TMenuItem);
544  var
545    i: Integer;
546  begin
547    if Item.Owner=nil then
548      AMenu.Owner.InsertComponent(Item);
549    for i:=0 to Item.Count-1 do
550      SetOwner(Item[i]);
551  end;
552
553var
554  i: Integer;
555begin
556  for i:=Low(Items) to High(Items) do begin
557    SetOwner(Items[i]);
558    AMenu.FItems.Add(Items[i]);
559  end;
560end;
561
562function NewMenu(Owner: TComponent; const AName: string;
563  const Items: array of TMenuItem): TMainMenu;
564begin
565  Result:=TMainMenu.Create(Owner);
566  Result.Name:=AName;
567  AddMenuItems(Result,Items);
568end;
569
570function NewPopupMenu(Owner: TComponent; const AName: string;
571  Alignment: TPopupAlignment; AutoPopup: Boolean;
572  const Items: array of TMenuItem): TPopupMenu;
573begin
574  Result:=TPopupMenu.Create(Owner);
575  Result.Name:=AName;
576  Result.AutoPopup:=AutoPopup;
577  Result.Alignment:=Alignment;
578  AddMenuItems(Result,Items);
579end;
580
581function NewSubMenu(const ACaption: string; hCtx: THelpContext;
582  const AName: string; const Items: array of TMenuItem; TheEnabled: Boolean
583  ): TMenuItem;
584var
585  i: Integer;
586begin
587  Result:=TMenuItem.Create(nil);
588  for i:=Low(Items) to High(Items) do
589    Result.Add(Items[i]);
590  Result.Caption:=ACaption;
591  Result.HelpContext:=hCtx;
592  Result.Name:=AName;
593  Result.Enabled:=TheEnabled;
594end;
595
596function NewItem(const ACaption: string; AShortCut: TShortCut; AChecked,
597  TheEnabled: Boolean; TheOnClick: TNotifyEvent; hCtx: THelpContext;
598  const AName: string): TMenuItem;
599begin
600  Result:=TMenuItem.Create(nil);
601  with Result do begin
602    Caption:=ACaption;
603    ShortCut:=AShortCut;
604    OnClick:=TheOnClick;
605    HelpContext:=hCtx;
606    Checked:=AChecked;
607    Enabled:=TheEnabled;
608    Name:=AName;
609  end;
610end;
611
612function NewLine: TMenuItem;
613begin
614  Result := TMenuItem.Create(nil);
615  Result.Caption := cLineCaption;
616end;
617
618function StripHotkey(const Text: string): string;
619var
620  I, R: Integer;
621begin
622  SetLength(Result, Length(Text));
623  I := 1;
624  R := 1;
625  while I <= Length(Text) do
626  begin
627    if Text[I] = cHotkeyPrefix then
628    begin
629      if (I < Length(Text)) and (Text[I+1] = cHotkeyPrefix) then
630      begin
631        Result[R] := Text[I];
632        Inc(R);
633        Inc(I, 2);
634      end else
635        Inc(I);
636    end else
637    begin
638      Result[R] := Text[I];
639      Inc(R);
640      Inc(I);
641    end;
642  end;
643  SetLength(Result, R-1);
644end;
645
646procedure Register;
647begin
648  RegisterComponents('Standard',[TMainMenu,TPopupMenu]);
649  RegisterNoIcon([TMenuItem]);
650end;
651
652{$I menu.inc}
653{$I menuitem.inc}
654{$I mainmenu.inc}
655{$I popupmenu.inc}
656{$I menuactionlink.inc}
657
658function ShortCut(const Key: Word; const Shift : TShiftState) : TShortCut;
659begin
660  Result := LCLType.KeyToShortCut(Key,Shift);
661end;
662
663procedure ShortCutToKey(const ShortCut: TShortCut; out Key: Word;
664  out Shift : TShiftState);
665begin
666  Key := ShortCut and $FF;
667  Shift := [];
668  if ShortCut and scShift <> 0 then Include(Shift,ssShift);
669  if ShortCut and scAlt <> 0 then Include(Shift,ssAlt);
670  if ShortCut and scCtrl <> 0 then Include(Shift,ssCtrl);
671  if ShortCut and scMeta <> 0 then Include(Shift,ssMeta);
672end;
673
674{ TMenuItemEnumerator }
675
676function TMenuItemEnumerator.GetCurrent: TMenuItem;
677begin
678  Result := FMenuItem.Items[FPosition];
679end;
680
681constructor TMenuItemEnumerator.Create(AMenuItem: TMenuItem);
682begin
683  FMenuItem := AMenuItem;
684  FPosition := -1;
685end;
686
687function TMenuItemEnumerator.MoveNext: Boolean;
688begin
689  inc(FPosition);
690  Result := FPosition < FMenuItem.Count;
691end;
692
693end.
694