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