File: menus.pp

package info (click to toggle)
lazarus 2.0.10%2Bdfsg-4
  • links: PTS, VCS
  • area: main
  • in suites: bullseye
  • size: 219,188 kB
  • sloc: pascal: 1,867,962; xml: 265,716; cpp: 56,595; sh: 3,005; java: 609; makefile: 568; perl: 297; sql: 222; ansic: 137
file content (693 lines) | stat: -rw-r--r-- 24,710 bytes parent folder | download | duplicates (2)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
{
 /***************************************************************************
                                     menus.pp
                                     --------
                   Component Library TMenu, TMenuItem Controls
                   Initial Revision  : Mon Jul 26 0:10:12 1999


 ***************************************************************************/

 *****************************************************************************
  This file is part of the Lazarus Component Library (LCL)

  See the file COPYING.modifiedLGPL.txt, included in this distribution,
  for details about the license.
 *****************************************************************************
}

{
TMenu, TMenuItem
@author(TMenu - Shane Miller <smiller@lakefield.net>)
@author(TMenuItem - Shane Miller <smiller@lakefield.net>)
@author(TMainMenu - Marc Weustink <weus@quicknet.nl>)
@author(TPopupMenu - Marc Weustink <weus@quicknet.nl>
@created(26-Jul-1999)
@lastmod(27-Oct-1999)

Detailed description of the Unit.
}
unit Menus;

{$mode objfpc}{$H+}

interface

{$ifdef Trace}
{$ASSERTIONS ON}
{$endif}

uses
  Types, Classes, SysUtils,
  // LCL
  LCLStrConsts, LCLType, LCLProc, LCLIntf, LCLClasses, LResources, LMessages,
  ActnList, Graphics, ImgList, Themes,
  // LazUtils
  LazMethodList, LazLoggerBase;

type
  TMenu = class;
  TMenuItem = class;
  EMenuError = class(Exception);

  TGlyphShowMode = (
    gsmAlways,       // always show
    gsmNever,        // never show
    gsmApplication,  // depends on application settings
    gsmSystem        // depends on system settings
  );

  TMenuChangeEvent = procedure (Sender: TObject; Source: TMenuItem;
                                Rebuild: Boolean) of object;

  { TMenuActionLink }

  TMenuActionLink = class(TActionLink)
  protected
    FClient: TMenuItem;
    procedure AssignClient(AClient: TObject); override;
    function IsAutoCheckLinked: Boolean; virtual;
  protected
    function IsOnExecuteLinked: Boolean; override;
    procedure SetAutoCheck(Value: Boolean); override;
    procedure SetCaption(const Value: string); override;
    procedure SetChecked(Value: Boolean); override;
    procedure SetEnabled(Value: Boolean); override;
    procedure SetHelpContext(Value: THelpContext); override;
    procedure SetHint(const Value: string); override;
    procedure SetImageIndex(Value: Integer); override;
    procedure SetShortCut(Value: TShortCut); override;
    procedure SetVisible(Value: Boolean); override;
    procedure SetOnExecute(Value: TNotifyEvent); override;
  public
    function IsCaptionLinked: Boolean; override;
    function IsCheckedLinked: Boolean; override;
    function IsEnabledLinked: Boolean; override;
    function IsHelpContextLinked: Boolean; override;
    function IsHintLinked: Boolean; override;
    function IsGroupIndexLinked: Boolean; override;
    function IsImageIndexLinked: Boolean; override;
    function IsShortCutLinked: Boolean; override;
    function IsVisibleLinked: Boolean; override;
  end;

  TMenuActionLinkClass = class of TMenuActionLink;

  { TMenuItemEnumerator }

  TMenuItemEnumerator = class
  private
    FMenuItem: TMenuItem;
    FPosition: Integer;
    function GetCurrent: TMenuItem;
  public
    constructor Create(AMenuItem: TMenuItem);
    function MoveNext: Boolean;
    property Current: TMenuItem read GetCurrent;
  end;

  { TMenuItem }
  
  TMenuItemHandlerType = (
    mihtDestroy
    );

  TMenuDrawItemEvent = procedure(Sender: TObject; ACanvas: TCanvas;
    ARect: TRect; AState: TOwnerDrawState) of object;
  TMenuMeasureItemEvent = procedure(Sender: TObject; ACanvas: TCanvas;
    var AWidth, AHeight: Integer) of object;

  TMenuItem = class(TLCLComponent)
  private
    FActionLink: TMenuActionLink;
    FCaption: TTranslateString;
    FBitmap: TBitmap;
    FGlyphShowMode: TGlyphShowMode;
    FHandle: HMenu;
    FHelpContext: THelpContext;
    FHint: String;
    FImageChangeLink: TChangeLink;
    FImageIndex: TImageIndex;
    FItems: TList; // list of TMenuItem
    FMenu: TMenu;
    FOnChange: TMenuChangeEvent;
    FOnClick: TNotifyEvent;
    FOnDrawItem: TMenuDrawItemEvent;
    FOnMeasureItem: TMenuMeasureItemEvent;
    FParent: TMenuItem;
    FMenuItemHandlers: array[TMenuItemHandlerType] of TMethodList;
    FSubMenuImages: TCustomImageList;
    FSubMenuImagesWidth: Integer;
    FShortCut: TShortCut;
    FShortCutKey2: TShortCut;
    FGroupIndex: Byte;
    FRadioItem: Boolean;
    FRightJustify: boolean;
    FShowAlwaysCheckable: boolean;
    FVisible: Boolean;
    // True => Bitmap property indicates assigned Bitmap.
    // False => Bitmap property is not assigned but can represent imagelist bitmap
    FBitmapIsValid: Boolean;
    FAutoCheck: Boolean;
    FChecked: Boolean;
    FDefault: Boolean;
    FEnabled: Boolean;
    function GetBitmap: TBitmap;
    function GetCount: Integer;
    function GetItem(Index: Integer): TMenuItem;
    function GetMenuIndex: Integer;
    function GetParent: TMenuItem;
    function IsBitmapStored: boolean;
    function IsCaptionStored: boolean;
    function IsCheckedStored: boolean;
    function IsEnabledStored: boolean;
    function IsHelpContextStored: boolean;
    function IsHintStored: Boolean;
    function IsImageIndexStored: Boolean;
    function IsShortCutStored: boolean;
    function IsVisibleStored: boolean;
    procedure SetAutoCheck(const AValue: boolean);
    procedure SetCaption(const AValue: TTranslateString);
    procedure SetChecked(AValue: Boolean);
    procedure SetDefault(AValue: Boolean);
    procedure SetEnabled(AValue: Boolean);
    procedure SetBitmap(const AValue: TBitmap);
    procedure SetGlyphShowMode(const AValue: TGlyphShowMode);
    procedure SetMenuIndex(AValue: Integer);
    procedure SetName(const Value: TComponentName); override;
    procedure SetRadioItem(const AValue: Boolean);
    procedure SetRightJustify(const AValue: boolean);
    procedure SetShowAlwaysCheckable(const AValue: boolean);
    procedure SetSubMenuImages(const AValue: TCustomImageList);
    procedure SetSubMenuImagesWidth(const aSubMenuImagesWidth: Integer);
    procedure ShortcutChanged;
    procedure SubItemChanged(Sender: TObject; Source: TMenuItem; Rebuild: Boolean);
    procedure TurnSiblingsOff;
    procedure DoActionChange(Sender: TObject);
  protected
    FCommand: Word;
    class procedure WSRegisterClass; override;
    procedure ActionChange(Sender: TObject; CheckDefaults: Boolean); virtual;
    procedure AssignTo(Dest: TPersistent); override;
    procedure BitmapChange(Sender: TObject);
    function DoDrawItem(ACanvas: TCanvas; ARect: TRect; AState: TOwnerDrawState): Boolean; virtual;
    function DoMeasureItem(ACanvas: TCanvas; var AWidth, AHeight: Integer): Boolean; virtual;
    function GetAction: TBasicAction;
    function GetActionLinkClass: TMenuActionLinkClass; virtual;
    function GetHandle: HMenu;
    procedure DoClicked(var msg); message LM_ACTIVATE;
    procedure CheckChildrenHandles;
    procedure CreateHandle; virtual;
    procedure DestroyHandle; virtual;
    procedure Loaded; override;
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
    procedure GetChildren(Proc: TGetChildProc; Root: TComponent); override;
    procedure InitiateActions;
    procedure MenuChanged(Rebuild : Boolean);
    procedure SetAction(NewAction: TBasicAction);
    procedure SetChildOrder(Child: TComponent; Order: Integer); override;
    procedure SetGroupIndex(AValue: Byte);
    procedure SetImageIndex(AValue : TImageIndex);
    procedure SetParentComponent(AValue : TComponent); override;
    procedure SetShortCut(const AValue : TShortCut);
    procedure SetShortCutKey2(const AValue : TShortCut);
    procedure SetVisible(AValue: Boolean);
    procedure UpdateImage;
    procedure UpdateImages;
    procedure UpdateWSIcon;
    procedure ImageListChange(Sender: TObject);
  protected
    property ActionLink: TMenuActionLink read FActionLink write FActionLink;
  public
    FCompStyle: LongInt;
    constructor Create(TheOwner: TComponent); override;
    destructor Destroy; override;
    function Find(const ACaption: string): TMenuItem;
    function GetEnumerator: TMenuItemEnumerator;
    procedure GetImageList(out aImages: TCustomImageList; out aImagesWidth: Integer); virtual;
    function GetImageList: TCustomImageList;
    function GetParentComponent: TComponent; override;
    function GetParentMenu: TMenu; virtual;
    function GetIsRightToLeft:Boolean; virtual;
    function HandleAllocated : Boolean;
    function HasIcon: boolean; virtual;
    function HasParent: Boolean; override;
    procedure InitiateAction; virtual;
    procedure IntfDoSelect; virtual;
    function IndexOf(Item: TMenuItem): Integer;
    function IndexOfCaption(const ACaption: string): Integer; virtual;
    function VisibleIndexOf(Item: TMenuItem): Integer;
    procedure Add(Item: TMenuItem);
    procedure Add(const AItems: array of TMenuItem);
    procedure AddSeparator;
    procedure Click; virtual;
    procedure Delete(Index: Integer);
    procedure HandleNeeded; virtual;
    procedure Insert(Index: Integer; Item: TMenuItem);
    procedure RecreateHandle; virtual;
    procedure Remove(Item: TMenuItem);
    function IsCheckItem: boolean; virtual;
    function IsLine: Boolean;
    function IsInMenuBar: boolean; virtual;
    procedure Clear;
    function HasBitmap: boolean;
    function GetIconSize(ADC: HDC): TPoint; virtual;
    // Event lists
    procedure RemoveAllHandlersOfObject(AnObject: TObject); override;
    procedure AddHandlerOnDestroy(const OnDestroyEvent: TNotifyEvent;
                                  AsFirst: boolean = false);
    procedure RemoveHandlerOnDestroy(const OnDestroyEvent: TNotifyEvent);
    procedure AddHandler(HandlerType: TMenuItemHandlerType;
                         const AMethod: TMethod; AsFirst: boolean = false);
    procedure RemoveHandler(HandlerType: TMenuItemHandlerType;
                            const AMethod: TMethod);
  public
    property Count: Integer read GetCount;
    property Handle: HMenu read GetHandle write FHandle;
    property Items[Index: Integer]: TMenuItem read GetItem; default;
    property MenuIndex: Integer read GetMenuIndex write SetMenuIndex;
    property Menu: TMenu read FMenu;
    property Parent: TMenuItem read GetParent;
    property Command: Word read FCommand;
    function MenuVisibleIndex: integer;
    procedure WriteDebugReport(const Prefix: string);
  published
    property Action: TBasicAction read GetAction write SetAction;
    property AutoCheck: boolean read FAutoCheck write SetAutoCheck default False;
    property Caption: TTranslateString read FCaption write SetCaption
                             stored IsCaptionStored;
    property Checked: Boolean read FChecked write SetChecked
                              stored IsCheckedStored default False;
    property Default: Boolean read FDefault write SetDefault default False;
    property Enabled: Boolean read FEnabled write SetEnabled
                              stored IsEnabledStored default True;
    property Bitmap: TBitmap read GetBitmap write SetBitmap stored IsBitmapStored;
    property GroupIndex: Byte read FGroupIndex write SetGroupIndex default 0;
    property GlyphShowMode: TGlyphShowMode read FGlyphShowMode write SetGlyphShowMode default gsmApplication;
    property HelpContext: THelpContext read FHelpContext write FHelpContext
                                           stored IsHelpContextStored default 0;
    property Hint: TTranslateString read FHint write FHint stored IsHintStored;
    property ImageIndex: TImageIndex read FImageIndex write SetImageIndex
                                           stored IsImageIndexStored default -1;
    property RadioItem: Boolean read FRadioItem write SetRadioItem default False;
    property RightJustify: boolean read FRightJustify write SetRightJustify default False;
    property ShortCut: TShortCut read FShortCut write SetShortCut
                                 stored IsShortCutStored default 0;
    property ShortCutKey2: TShortCut read FShortCutKey2 write SetShortCutKey2 default 0;
    property ShowAlwaysCheckable: boolean read FShowAlwaysCheckable
                                 write SetShowAlwaysCheckable default False;
    property SubMenuImages: TCustomImageList read FSubMenuImages write SetSubMenuImages;
    property SubMenuImagesWidth: Integer read FSubMenuImagesWidth write SetSubMenuImagesWidth default 0;
    property Visible: Boolean read FVisible write SetVisible
                              stored IsVisibleStored default True;
    property OnClick: TNotifyEvent read FOnClick write FOnClick;
    property OnDrawItem: TMenuDrawItemEvent read FOnDrawItem write FOnDrawItem;
    property OnMeasureItem: TMenuMeasureItemEvent read FOnMeasureItem write FOnMeasureItem;
  end;
  TMenuItemClass = class of TMenuItem;


  { TMenu }

  TFindItemKind = (fkCommand, fkHandle, fkShortCut);

  TMenu = class(TLCLComponent)
  private
    FBiDiMode: TBiDiMode;
    FImageChangeLink: TChangeLink;
    FImages: TCustomImageList;
    FImagesWidth: Integer;
    FItems: TMenuItem;
    FOnDrawItem: TMenuDrawItemEvent;
    FOnChange: TMenuChangeEvent;
    FOnMeasureItem: TMenuMeasureItemEvent;
    FOwnerDraw: Boolean;
    FParent: TComponent;
    FParentBiDiMode: Boolean;
    FShortcutHandled: boolean;
//See TCustomForm.CMBiDiModeChanged
    procedure CMParentBiDiModeChanged(var Message: TLMessage); message CM_PARENTBIDIMODECHANGED;
    procedure CMAppShowMenuGlyphChanged(var Message: TLMessage); message CM_APPSHOWMENUGLYPHCHANGED;
    function IsBiDiModeStored: Boolean;
    procedure ImageListChange(Sender: TObject);
    procedure SetBiDiMode(const AValue: TBiDiMode);
    procedure SetImages(const AValue: TCustomImageList);
    procedure SetImagesWidth(const aImagesWidth: Integer);
    procedure SetParent(const AValue: TComponent);
    procedure SetParentBiDiMode(const AValue: Boolean);
  protected
    class procedure WSRegisterClass; override;
    procedure BidiModeChanged; virtual;
    procedure CreateHandle; virtual;
    procedure DoChange(Source: TMenuItem; Rebuild: Boolean); virtual;
    function GetHandle: HMENU; virtual;
    procedure GetChildren(Proc: TGetChildProc; Root: TComponent); override;
    procedure MenuChanged(Sender: TObject; Source: TMenuItem;
                          Rebuild: Boolean); virtual;
    procedure AssignTo(Dest: TPersistent); override;
    procedure Notification(AComponent: TComponent;
      Operation: TOperation); override;
    procedure ParentBidiModeChanged;
    procedure ParentBidiModeChanged(AOwner:TComponent);//used in Create constructor
    procedure SetChildOrder(Child: TComponent; Order: Integer); override;
    procedure UpdateItems;

    property OnChange: TMenuChangeEvent read FOnChange write FOnChange;
  public
    FCompStyle: LongInt;
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure DestroyHandle; virtual;
    function FindItem(AValue: PtrInt; Kind: TFindItemKind): TMenuItem;
    function GetHelpContext(AValue: PtrInt; ByCommand: Boolean): THelpContext;
    function IsShortcut(var Message: TLMKey): boolean;
    function HandleAllocated: Boolean;
    function IsRightToLeft: Boolean; virtual;
    function UseRightToLeftAlignment: Boolean; virtual;
    function UseRightToLeftReading: Boolean; virtual;
    procedure HandleNeeded;
    function DispatchCommand(ACommand: Word): Boolean;
  public
    property Handle: HMenu read GetHandle;
    property Parent: TComponent read FParent write SetParent;
    property ShortcutHandled: boolean read FShortcutHandled write FShortcutHandled;
  published
    property BidiMode:TBidiMode read FBidiMode write SetBidiMode stored IsBiDiModeStored default bdLeftToRight;
    property ParentBidiMode:Boolean read FParentBidiMode write SetParentBidiMode default True;
    property Items: TMenuItem read FItems;
    property Images: TCustomImageList read FImages write SetImages;
    property ImagesWidth: Integer read FImagesWidth write SetImagesWidth default 0;
    property OwnerDraw: Boolean read FOwnerDraw write FOwnerDraw default False;
    property OnDrawItem: TMenuDrawItemEvent read FOnDrawItem write FOnDrawItem;
    property OnMeasureItem: TMenuMeasureItemEvent read FOnMeasureItem write FOnMeasureItem;
  end;


  { TMainMenu }

  TMainMenu = class(TMenu)
  private
    FWindowHandle: HWND;
    function GetHeight: Integer;
    procedure SetWindowHandle(const AValue: HWND);
  protected
    procedure ItemChanged;
    class procedure WSRegisterClass; override;
    procedure MenuChanged(Sender: TObject; Source: TMenuItem; Rebuild: Boolean); override;
  public
    constructor Create(AOwner: TComponent); override;
    property Height: Integer read GetHeight;
    property WindowHandle: HWND read FWindowHandle write SetWindowHandle;
  published
    property OnChange;
  end;


  { TPopupMenu }

  TPopupAlignment = (paLeft, paRight, paCenter);
  TTrackButton = (tbRightButton, tbLeftButton);

  TPopupMenu = class(TMenu)
  private
    FAlignment: TPopupAlignment;
    FAutoPopup: Boolean;
    FOnClose: TNotifyEvent;
    FOnPopup: TNotifyEvent;
    FPopupComponent: TComponent;
    FPopupPoint: TPoint;
    FTrackButton: TTrackButton;
    function GetHelpContext: THelpContext;
    procedure SetHelpContext(const AValue: THelpContext);
  protected
    class procedure WSRegisterClass; override;
    procedure DoPopup(Sender: TObject); virtual;
    procedure DoClose; virtual;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure PopUp;
    procedure PopUp(X, Y: Integer); virtual;
    property PopupComponent: TComponent read FPopupComponent write FPopupComponent;
    property PopupPoint: TPoint read FPopupPoint;
    procedure Close;
  published
    property Alignment: TPopupAlignment read FAlignment write FAlignment default paLeft;
    property AutoPopup: Boolean read FAutoPopup write FAutoPopup default True;
    property HelpContext: THelpContext read GetHelpContext write SetHelpContext default 0;
    property TrackButton: TTrackButton read FTrackButton write FTrackButton default tbRightButton;
    property OnPopup: TNotifyEvent read FOnPopup write FOnPopup;
    property OnClose: TNotifyEvent read FOnClose write FOnClose;
  end;

function ShortCut(const Key: Word; const Shift : TShiftState) : TShortCut;
procedure ShortCutToKey(const ShortCut : TShortCut; out Key: Word;
                        out Shift : TShiftState);

var
  DesignerMenuItemClick: TNotifyEvent = nil;
  ActivePopupMenu: TPopupMenu = nil;
  OnMenuPopupHandler: TNotifyEvent = nil;

function NewMenu(Owner: TComponent; const AName: string;
                 const Items: array of TMenuItem): TMainMenu;
function NewPopupMenu(Owner: TComponent; const AName: string;
                      Alignment: TPopupAlignment; AutoPopup: Boolean;
                      const Items: array of TMenuItem): TPopupMenu;
function NewSubMenu(const ACaption: string; hCtx: THelpContext;
                    const AName: string; const Items: array of TMenuItem;
                    TheEnabled: Boolean = True): TMenuItem;
function NewItem(const ACaption: string; AShortCut: TShortCut;
                 AChecked, TheEnabled: Boolean; TheOnClick: TNotifyEvent;
                 hCtx: THelpContext; const AName: string): TMenuItem;
function NewLine: TMenuItem;

function StripHotkey(const Text: string): string;

procedure Register;


const
  cHotkeyPrefix   = '&';
  cLineCaption    = '-';
  cDialogSuffix   = '...';

  ValidMenuHotkeys: string = '1234567890ABCDEFGHIJKLMNOPQRSTUVWXYZ';



implementation

uses
  WSMenus,
  Forms {KeyDataToShiftState};

{ Helpers for Assign() }

procedure MenuItem_Copy(ASrc, ADest: TMenuItem);
var
  mi: TMenuItem;
  i: integer;
begin
  ADest.Clear;
  ADest.Action:= ASrc.Action;
  ADest.AutoCheck:= ASrc.AutoCheck;
  ADest.Caption:= ASrc.Caption;
  ADest.Checked:= ASrc.Checked;
  ADest.Default:= ASrc.Default;
  ADest.Enabled:= ASrc.Enabled;
  ADest.Bitmap:= ASrc.Bitmap;
  ADest.GroupIndex:= ASrc.GroupIndex;
  ADest.GlyphShowMode:= ASrc.GlyphShowMode;
  ADest.HelpContext:= ASrc.HelpContext;
  ADest.Hint:= ASrc.Hint;
  ADest.ImageIndex:= ASrc.ImageIndex;
  ADest.RadioItem:= ASrc.RadioItem;
  ADest.RightJustify:= ASrc.RightJustify;
  ADest.ShortCut:= ASrc.ShortCut;
  ADest.ShortCutKey2:= ASrc.ShortCutKey2;
  ADest.ShowAlwaysCheckable:= ASrc.ShowAlwaysCheckable;
  ADest.SubMenuImages:= ASrc.SubMenuImages;
  ADest.SubMenuImagesWidth:= ASrc.SubMenuImagesWidth;
  ADest.Visible:= ASrc.Visible;
  ADest.OnClick:= ASrc.OnClick;
  ADest.OnDrawItem:= ASrc.OnDrawItem;
  ADest.OnMeasureItem:= ASrc.OnMeasureItem;
  ADest.Tag:= ASrc.Tag;

  for i:= 0 to ASrc.Count-1 do
  begin
    mi:= TMenuItem.Create(ASrc.Owner);
    MenuItem_Copy(ASrc.Items[i], mi);
    ADest.Add(mi);
  end;
end;

procedure Menu_Copy(ASrc, ADest: TMenu);
begin
  ADest.BidiMode:= ASrc.BidiMode;
  ADest.ParentBidiMode:= ASrc.ParentBidiMode;
  ADest.Images:= ASrc.Images;
  ADest.ImagesWidth:= ASrc.ImagesWidth;
  ADest.OwnerDraw:= ASrc.OwnerDraw;
  ADest.OnDrawItem:= ASrc.OnDrawItem;
  ADest.OnMeasureItem:= ASrc.OnMeasureItem;

  MenuItem_Copy(ASrc.Items, ADest.Items);
end;

{ Easy Menu building }

procedure AddMenuItems(AMenu: TMenu; const Items: array of TMenuItem);

  procedure SetOwner(Item: TMenuItem);
  var
    i: Integer;
  begin
    if Item.Owner=nil then
      AMenu.Owner.InsertComponent(Item);
    for i:=0 to Item.Count-1 do
      SetOwner(Item[i]);
  end;

var
  i: Integer;
begin
  for i:=Low(Items) to High(Items) do begin
    SetOwner(Items[i]);
    AMenu.FItems.Add(Items[i]);
  end;
end;

function NewMenu(Owner: TComponent; const AName: string;
  const Items: array of TMenuItem): TMainMenu;
begin
  Result:=TMainMenu.Create(Owner);
  Result.Name:=AName;
  AddMenuItems(Result,Items);
end;

function NewPopupMenu(Owner: TComponent; const AName: string;
  Alignment: TPopupAlignment; AutoPopup: Boolean;
  const Items: array of TMenuItem): TPopupMenu;
begin
  Result:=TPopupMenu.Create(Owner);
  Result.Name:=AName;
  Result.AutoPopup:=AutoPopup;
  Result.Alignment:=Alignment;
  AddMenuItems(Result,Items);
end;

function NewSubMenu(const ACaption: string; hCtx: THelpContext;
  const AName: string; const Items: array of TMenuItem; TheEnabled: Boolean
  ): TMenuItem;
var
  i: Integer;
begin
  Result:=TMenuItem.Create(nil);
  for i:=Low(Items) to High(Items) do
    Result.Add(Items[i]);
  Result.Caption:=ACaption;
  Result.HelpContext:=hCtx;
  Result.Name:=AName;
  Result.Enabled:=TheEnabled;
end;

function NewItem(const ACaption: string; AShortCut: TShortCut; AChecked,
  TheEnabled: Boolean; TheOnClick: TNotifyEvent; hCtx: THelpContext;
  const AName: string): TMenuItem;
begin
  Result:=TMenuItem.Create(nil);
  with Result do begin
    Caption:=ACaption;
    ShortCut:=AShortCut;
    OnClick:=TheOnClick;
    HelpContext:=hCtx;
    Checked:=AChecked;
    Enabled:=TheEnabled;
    Name:=AName;
  end;
end;

function NewLine: TMenuItem;
begin
  Result := TMenuItem.Create(nil);
  Result.Caption := cLineCaption;
end;

function StripHotkey(const Text: string): string;
var
  I, R: Integer;
begin
  SetLength(Result, Length(Text));
  I := 1;
  R := 1;
  while I <= Length(Text) do
  begin
    if Text[I] = cHotkeyPrefix then
    begin
      if (I < Length(Text)) and (Text[I+1] = cHotkeyPrefix) then
      begin
        Result[R] := Text[I];
        Inc(R);
        Inc(I, 2);
      end else
        Inc(I);
    end else
    begin
      Result[R] := Text[I];
      Inc(R);
      Inc(I);
    end;
  end;
  SetLength(Result, R-1);
end;

procedure Register;
begin
  RegisterComponents('Standard',[TMainMenu,TPopupMenu]);
  RegisterNoIcon([TMenuItem]);
end;

{$I menu.inc}
{$I menuitem.inc}
{$I mainmenu.inc}
{$I popupmenu.inc}
{$I menuactionlink.inc}

function ShortCut(const Key: Word; const Shift : TShiftState) : TShortCut;
begin
  Result := LCLType.KeyToShortCut(Key,Shift);
end;

procedure ShortCutToKey(const ShortCut: TShortCut; out Key: Word;
  out Shift : TShiftState);
begin
  Key := ShortCut and $FF;
  Shift := [];
  if ShortCut and scShift <> 0 then Include(Shift,ssShift);
  if ShortCut and scAlt <> 0 then Include(Shift,ssAlt);
  if ShortCut and scCtrl <> 0 then Include(Shift,ssCtrl);
  if ShortCut and scMeta <> 0 then Include(Shift,ssMeta);
end;

{ TMenuItemEnumerator }

function TMenuItemEnumerator.GetCurrent: TMenuItem;
begin
  Result := FMenuItem.Items[FPosition];
end;

constructor TMenuItemEnumerator.Create(AMenuItem: TMenuItem);
begin
  FMenuItem := AMenuItem;
  FPosition := -1;
end;

function TMenuItemEnumerator.MoveNext: Boolean;
begin
  inc(FPosition);
  Result := FPosition < FMenuItem.Count;
end;

end.