1{%MainUnit ../menus.pp} 2 3{****************************************************************************** 4 TMenuItem 5 ****************************************************************************** 6 7 ***************************************************************************** 8 This file is part of the Lazarus Component Library (LCL) 9 10 See the file COPYING.modifiedLGPL.txt, included in this distribution, 11 for details about the license. 12 ***************************************************************************** 13} 14 15{------------------------------------------------------------------------------ 16 Method: TMenuItem.Add 17 Params: Item: 18 Returns: Nothing 19 20 Description of the procedure for the class. 21 ------------------------------------------------------------------------------} 22procedure TMenuItem.Add(Item: TMenuItem); 23begin 24 Insert(GetCount, Item); 25end; 26 27procedure TMenuItem.Add(const AItems: array of TMenuItem); 28var 29 i: Integer; 30begin 31 for i := Low(AItems) to High(AItems) do 32 Add(AItems[i]); 33end; 34 35{------------------------------------------------------------------------------ 36 procedure TMenuItem.AddSeparator; 37 ------------------------------------------------------------------------------} 38procedure TMenuItem.AddSeparator; 39var 40 Item: TMenuItem; 41begin 42 Item := TMenuItem.Create(Self); 43 Item.Caption := cLineCaption; 44 Add(Item); 45end; 46 47{------------------------------------------------------------------------------ 48 procedure TMenuItem.Click; 49 50 Call hooks and actions. 51 ------------------------------------------------------------------------------} 52procedure TMenuItem.Click; 53 54 function OnClickIsActionExecute: boolean; 55 begin 56 Result:=false; 57 if Action=nil then exit; 58 if not Assigned(Action.OnExecute) then exit; 59 if not Assigned(FOnClick) then exit; 60 Result:=CompareMethods(TMethod(FOnClick),TMethod(Action.OnExecute)); 61 end; 62 63var 64 CallAction: Boolean; 65begin 66 if not Enabled then Exit; 67 if Assigned(OnMenuPopupHandler) then 68 OnMenuPopupHandler(Self); 69 70 if AutoCheck 71 and not (Assigned(ActionLink) and ActionLink.IsAutoCheckLinked) 72 and not (csDesigning in ComponentState) 73 then begin 74 // Break a little Delphi compatibility 75 // It makes no sense to uncheck a checked RadioItem (besides, GTK can't handle it) 76 if not (RadioItem and Checked) then 77 Checked := not Checked; 78 end; 79 80 CallAction := Assigned(ActionLink) and not (csDesigning in ComponentState); 81 // first call our own OnClick if it differs from Action.OnExecute 82 if Assigned(FOnClick) and not (CallAction and OnClickIsActionExecute) then 83 FOnClick(Self); 84 // then trigger the Action 85 if CallAction then 86 ActionLink.Execute(Self); 87end; 88 89{------------------------------------------------------------------------------ 90 Method: TMenuItem.Create 91 Params: TheOwner: the owner of the class 92 Returns: Nothing 93 94 Constructor for the class. 95 ------------------------------------------------------------------------------} 96constructor TMenuItem.Create(TheOwner: TComponent); 97begin 98 //DebugLn('TMenuItem.Create START TheOwner=',TheOwner.Name,':',TheOwner.ClassName); 99 //if not assigned (TheOwner) then debugln ('**SH: Warn: creating MenuItem with Owner = nil'); 100 101 inherited Create(TheOwner); 102 103 FCompStyle := csMenuItem; 104 FHandle := 0; 105 FItems := nil; 106 FMenu := nil; 107 FParent := nil; 108 FShortCut := 0; 109 FChecked := False; 110 FVisible := True; 111 FEnabled := True; 112 FCommand := TWSMenuItemClass(WidgetSetClass).OpenCommand; 113 FImageIndex := -1; 114 FBitmapIsValid := True; 115 FRightJustify := False; 116 FShowAlwaysCheckable := False; 117 FGlyphShowMode := gsmApplication; 118 119 FImageChangeLink := TChangeLink.Create; 120 FImageChangeLink.OnChange := @ImageListChange; 121 //DebugLn('TMenuItem.Create END TheOwner=',TheOwner.Name,':',TheOwner.ClassName); 122end; 123 124{------------------------------------------------------------------------------ 125 Method: TMenuItem.CreateHandle 126 Params: None 127 Returns: Nothing 128 129 Creates the handle ( = object). 130 ------------------------------------------------------------------------------} 131procedure TMenuItem.CreateHandle; 132begin 133 //DebugLn('TMenuItem.CreateHandle ',dbgsName(Self),' ',dbgs(Self)); 134 //DebugLn('TMenuItem.CreateHandle START ',Name,':',ClassName); 135 if not FVisible then RaiseGDBException(''); 136 FHandle := TWSMenuItemClass(WidgetSetClass).CreateHandle(Self); 137 CheckChildrenHandles; 138 139 if MergedParent <> nil then 140 begin 141 MergedParent.HandleNeeded; 142 //DebugLn('TMenuItem.CreateHandle Attaching ... ',Name,':',ClassName); 143 if MergedParent.HandleAllocated then 144 TWSMenuItemClass(WidgetSetClass).AttachMenu(Self); 145 146 if HandleAllocated then 147 begin 148 if ShortCut <> 0 then 149 ShortCutChanged; 150 end; 151 end; 152 //DebugLn('TMenuItem.CreateHandle END ',Name,':',ClassName); 153end; 154 155{------------------------------------------------------------------------------ 156 Method: TMenuItem.Delete 157 Params: Index: 158 Returns: Nothing 159 160 Description of the procedure for the class. 161 ------------------------------------------------------------------------------} 162procedure TMenuItem.Delete(Index: Integer); 163var 164 Cur: TMenuItem; 165begin 166 if (Index < 0) or (FItems = nil) or (Index >= GetCount) then 167 raise EMenuError.Create(SMenuIndexError); 168 Cur := TMenuItem(FItems[Index]); 169 if Cur = nil then 170 raise EMenuError.Create(SMenuItemIsNil); 171 Cur.DestroyHandle; 172 FItems.Delete(Index); 173 Cur.FParent := nil; 174 Cur.FOnChange := nil; 175 MenuChanged(Count = 0); 176end; 177 178{------------------------------------------------------------------------------ 179 Method: TMenuItem.Destroy 180 Params: None 181 Returns: Nothing 182 183 Destructor for the class. 184 ------------------------------------------------------------------------------} 185destructor TMenuItem.Destroy; 186var 187 i : integer; 188 HandlerType: TMenuItemHandlerType; 189begin 190 //debugln('TMenuItem.Destroy A ',dbgsName(Self),' ',Caption); 191 FMenuItemHandlers[mihtDestroy].CallNotifyEvents(Self); 192 if FBitmap <> nil then 193 FreeAndNil(FBitmap); 194 DestroyHandle; 195 if Assigned(FItems) then 196 begin 197 i := FItems.Count-1; 198 while i >= 0 do 199 begin 200 TMenuItem(FItems[i]).Free; 201 Dec(i); 202 end; 203 end; 204 if Assigned(FMerged) then 205 MergeWith(nil); 206 FreeAndNil(FItems); 207 FreeAndNil(FActionLink); 208 FreeAndNil(FImageChangeLink); 209 for HandlerType:= low(TMenuItemHandlerType) to high(TMenuItemHandlerType) do 210 FreeAndNil(FMenuItemHandlers[HandlerType]); 211 if FParent <> nil then 212 FParent.FItems.Remove(Self); 213 if FCommand <> 0 then TWSMenuItemClass(WidgetSetClass).CloseCommand(FCommand); 214 //debugln('TMenuItem.Destroy B ',dbgsName(Self)); 215 FreeAndNil(FMergedItems); 216 inherited Destroy; 217end; 218 219 220{ Find the menu item with a Caption of ACaption. Also for compatability with 221 Delphi. } 222function TMenuItem.Find(const ACaption: string): TMenuItem; 223var 224 Idx: Integer; 225begin 226 Result := nil; 227 Idx := IndexOfCaption(ACaption); 228 if Idx <> -1 then 229 Result := Items[Idx]; 230end; 231 232function TMenuItem.GetEnumerator: TMenuItemEnumerator; 233begin 234 Result := TMenuItemEnumerator.Create(Self); 235end; 236 237{------------------------------------------------------------------------------ 238 function TMenuItem.GetImageList: TCustomImageList; 239 240 241 ------------------------------------------------------------------------------} 242procedure TMenuItem.GetImageList(out aImages: TCustomImageList; out 243 aImagesWidth: Integer); 244var 245 LItem: TMenuItem; 246 LMenu: TMenu; 247begin 248 aImages := nil; 249 LItem := Parent; 250 while (LItem <> nil) and (LItem.SubMenuImages = nil) do 251 LItem := LItem.Parent; 252 if LItem <> nil then 253 begin 254 aImages := LItem.SubMenuImages; 255 aImagesWidth := LItem.SubMenuImagesWidth; 256 end else 257 begin 258 LMenu := GetParentMenu; 259 if LMenu <> nil then 260 begin 261 aImages := LMenu.Images; 262 aImagesWidth := LMenu.ImagesWidth; 263 end; 264 end; 265end; 266 267function TMenuItem.GetImageList: TCustomImageList; 268var 269 x: Integer; 270begin 271 GetImageList(Result, x); 272end; 273 274{------------------------------------------------------------------------------ 275 function TMenuItem.GetParentComponent: TComponent; 276 277 278 ------------------------------------------------------------------------------} 279function TMenuItem.GetParentComponent: TComponent; 280begin 281 if (FParent <> nil) and (FParent.FMenu <> nil) then 282 Result := FParent.FMenu 283 else 284 Result := FParent; 285end; 286 287{------------------------------------------------------------------------------ 288 Method: TMenuItem.DoClicked 289 ------------------------------------------------------------------------------} 290procedure TMenuItem.DoClicked(var msg); 291begin 292 // CheckChildrenHandles; <- This is already called when menuitem is created. 293 if not (csDesigning in ComponentState) then 294 begin 295 InitiateActions; 296 Click; 297 end 298 else 299 if Assigned(DesignerMenuItemClick) then 300 DesignerMenuItemClick(Self); 301end; 302 303function TMenuItem.DoDrawItem(ACanvas: TCanvas; ARect: TRect; 304 AState: TOwnerDrawState): Boolean; 305var 306 AParentMenu: TMenu; 307begin 308 Result := False; 309 if Assigned(FOnDrawItem) then 310 begin 311 FOnDrawItem(Self, ACanvas, ARect, AState); 312 Result := True; 313 end else 314 begin 315 AParentMenu := GetParentMenu; 316 if Assigned(AParentMenu.OnDrawItem) then 317 begin 318 AParentMenu.OnDrawItem(Self, ACanvas, ARect, AState); 319 Result := True; 320 end; 321 end; 322end; 323 324function TMenuItem.DoMeasureItem(ACanvas: TCanvas; var AWidth, 325 AHeight: Integer): Boolean; 326var 327 AParentMenu: TMenu; 328begin 329 Result := False; 330 if Assigned(FOnMeasureItem) then 331 begin 332 FOnMeasureItem(Self, ACanvas, AWidth, AHeight); 333 Result := True; 334 end else 335 begin 336 AParentMenu := GetParentMenu; 337 if Assigned(AParentMenu.OnMeasureItem) then 338 begin 339 AParentMenu.OnMeasureItem(Self, ACanvas, AWidth, AHeight); 340 Result := True; 341 end; 342 end; 343end; 344 345procedure TMenuItem.CheckChildrenHandles; 346 347 function GetMenu(Item: TMenuItem): TMenu; 348 begin 349 Result := nil; 350 repeat 351 if Assigned(Item.FMergedWith) then 352 begin 353 if Assigned(Item.FMergedWith.Menu) then 354 Result := Item.FMergedWith.Menu; 355 Item := Item.FMergedWith; 356 end else 357 begin 358 if Assigned(Item.Menu) then 359 Result := Item.Menu; 360 Item := Item.Parent; 361 end; 362 until (Item = nil); 363 end; 364 365var 366 i: Integer; 367 AMenu: TMenu; 368 AMergedItems: TMergedMenuItems; 369begin 370 if FItems = nil then 371 Exit; 372 373 AMenu := GetMenu(Self); 374 AMergedItems := MergedItems; 375 for i := 0 to AMergedItems.InvisibleCount-1 do 376 if AMergedItems.InvisibleItems[i].HandleAllocated then 377 AMergedItems.InvisibleItems[i].DestroyHandle; 378 379 for i := 0 to AMergedItems.VisibleCount-1 do 380 begin 381 if AMergedItems.VisibleItems[i].HandleAllocated and (GetMenu(AMergedItems.VisibleItems[i]) <> AMenu) then 382 AMergedItems.VisibleItems[i].DestroyHandle; 383 AMergedItems.VisibleItems[i].HandleNeeded; 384 end; 385end; 386 387procedure TMenuItem.IntfDoSelect; 388begin 389 Application.Hint := GetLongHint(Hint); 390end; 391 392procedure TMenuItem.InvalidateMergedItems; 393begin 394 FreeAndNil(FMergedItems); 395end; 396 397{------------------------------------------------------------------------------ 398 Function: TMenuItem.GetChildren 399 Params: Proc - proc to be called for each child 400 Root - root component 401 Returns: nothing 402 403 For each item call "proc" 404 ------------------------------------------------------------------------------} 405procedure TMenuItem.GetChildren(Proc: TGetChildProc; Root: TComponent); 406var 407 i : Integer; 408begin 409 if not assigned (FItems) then exit; 410 411 for i := 0 to FItems.Count - 1 do 412 Proc(TComponent(FItems[i])); 413end; 414 415function TMenuItem.GetAction: TBasicAction; 416begin 417 if FActionLink <> nil then 418 Result := FActionLink.Action 419 else 420 Result := nil; 421end; 422 423procedure TMenuItem.SetAction(NewAction: TBasicAction); 424begin 425 if NewAction = nil then 426 begin 427 FActionLink.Free; 428 FActionLink := nil; 429 end else 430 begin 431 if FActionLink = nil then 432 FActionLink := GetActionLinkClass.Create(Self); 433 FActionLink.Action := NewAction; 434 FActionLink.OnChange := @DoActionChange; 435 ActionChange(NewAction, csLoading in NewAction.ComponentState); 436 NewAction.FreeNotification(Self); 437 end; 438end; 439 440procedure TMenuItem.InitiateActions; 441var 442 i: Integer; 443begin 444 for i := 0 to Count - 1 do 445 Items[i].InitiateAction; 446end; 447 448procedure TMenuItem.ActionChange(Sender: TObject; CheckDefaults: Boolean); 449var 450 NewAction: TCustomAction; 451begin 452 if Sender is TCustomAction then 453 begin 454 NewAction := TCustomAction(Sender); 455 if (not CheckDefaults) or (AutoCheck = False) then 456 AutoCheck := NewAction.AutoCheck; 457 if (not CheckDefaults) or (Caption = '') then 458 Caption := NewAction.Caption; 459 if (not CheckDefaults) or (Checked = False) then 460 Checked := NewAction.Checked; 461 if (not CheckDefaults) or (Enabled = True) then 462 Enabled := NewAction.Enabled; 463 if (not CheckDefaults) or (HelpContext = 0) then 464 HelpContext := NewAction.HelpContext; 465 if (not CheckDefaults) or (Hint = '') then 466 Hint := NewAction.Hint; 467 if RadioItem and (not CheckDefaults or (GroupIndex = 0)) then 468 GroupIndex := NewAction.GroupIndex; 469 if (not CheckDefaults) or (ImageIndex = -1) then 470 ImageIndex := NewAction.ImageIndex; 471 if (not CheckDefaults) or (ShortCut = scNone) then 472 ShortCut := NewAction.ShortCut; 473 if (not CheckDefaults) or (Visible = True) then 474 Visible := NewAction.Visible; 475 end; 476end; 477 478function TMenuItem.GetActionLinkClass: TMenuActionLinkClass; 479begin 480 Result := TMenuActionLink; 481end; 482 483{------------------------------------------------------------------------------ 484 Function: TMenuItem.GetCount 485 Params: none 486 Returns: Number of child menuitems. 487 488 Returns the number of child menuitems. 489 ------------------------------------------------------------------------------} 490function TMenuItem.GetCount: Integer; 491begin 492 if FItems = nil then 493 Result := 0 494 else 495 Result := FItems.Count; 496end; 497 498function TMenuItem.GetBitmap: TBitmap; 499var 500 iml: TCustomImageList; 501 imw: Integer; 502begin 503 if FBitmap = nil then 504 begin 505 FBitmap := TBitmap.Create; 506 507 if ImageIndex >= 0 then 508 begin 509 GetImageList(iml, imw); 510 if (iml <> nil) and (ImageIndex < iml.Count) then 511 iml.ResolutionForPPI[imw, 96, 1].Resolution.GetBitmap(ImageIndex, FBitmap); 512 end; 513 514 FBitmap.OnChange := @BitmapChange; 515 end; 516 517 Result := FBitmap; 518end; 519 520{------------------------------------------------------------------------------ 521 Function: TMenuItem.GetHandle 522 Params: none 523 Returns: String containing output from the function. 524 525 Description of the function for the class. 526 ------------------------------------------------------------------------------} 527function TMenuItem.GetHandle: HMenu; 528begin 529 HandleNeeded; 530 Result := FHandle; 531end; 532 533{------------------------------------------------------------------------------ 534 Function: TMenuItem.GetItem 535 Params: none 536 Returns: String containing output from the function. 537 538 Description of the function for the class. 539 ------------------------------------------------------------------------------} 540function TMenuItem.GetItem(Index: Integer): TMenuItem; 541begin 542 if FItems = nil then 543 raise EMenuError.CreateFmt(rsIndexOutOfBounds,[ClassName,Index,-1]); 544 Result := TMenuItem(FItems[Index]); 545end; 546 547{------------------------------------------------------------------------------ 548 function TMenuItem.GetMenuIndex: Integer; 549 550 Get position of this menuitem in its menu 551 ------------------------------------------------------------------------------} 552function TMenuItem.GetMenuIndex: Integer; 553begin 554 Result := -1; 555 if FParent <> nil then Result := FParent.IndexOf(Self); 556end; 557 558function TMenuItem.GetMergedItems: TMergedMenuItems; 559begin 560 if not Assigned(FMergedItems) then 561 FMergedItems := TMergedMenuItems.Create(Self); 562 Result := FMergedItems; 563end; 564 565function TMenuItem.GetMergedParent: TMenuItem; 566begin 567 Result := Parent; 568 if Assigned(Result) and Assigned(Result.MergedWith) then 569 Result := Result.MergedWith; 570end; 571 572function TMenuItem.GetMergedParentMenu: TMenu; 573var 574 Item: TMenuItem; 575begin 576 Item := Self; 577 while Item.MergedParent <> nil do 578 Item := Item.MergedParent; 579 Result := Item.FMenu; 580end; 581 582{------------------------------------------------------------------------------ 583 Function: TMenuItem.GetParent 584 Params: none 585 Returns: String containing output from the function. 586 587 Description of the function for the class. 588 ------------------------------------------------------------------------------} 589function TMenuItem.GetParent: TMenuItem; 590begin 591 Result := FParent; 592end; 593 594function TMenuItem.IsBitmapStored: boolean; 595var 596 act: TCustomAction; 597begin 598 if Action <> nil then 599 begin 600 Result := true; 601 act := TCustomAction(Action); 602 if (act.ActionList <> nil) and (act.ActionList.Images <> nil) and 603 (act.ImageIndex >= 0) and (act.ImageIndex < act.ActionList.Images.Count) then 604 Result := false; 605 end 606 else Result := 607 FBitmapIsValid and 608 (FBitmap <> nil) and (not FBitmap.Empty) and 609 (FBitmap.Width > 0) and (FBitmap.Height > 0) and 610 (ImageIndex < 0); 611end; 612 613{------------------------------------------------------------------------------ 614 function TMenuItem.IsCaptionStored: boolean; 615 616 Checks if 'Caption' needs to be saved to stream 617 ------------------------------------------------------------------------------} 618function TMenuItem.IsCaptionStored: boolean; 619begin 620 Result := (ActionLink = nil) or not FActionLink.IsCaptionLinked; 621end; 622 623{------------------------------------------------------------------------------ 624 function TMenuItem.IsCheckedStored: boolean; 625 626 Checks if 'Checked' needs to be saved to stream 627 ------------------------------------------------------------------------------} 628function TMenuItem.IsCheckedStored: boolean; 629begin 630 Result := (ActionLink = nil) or not FActionLink.IsCheckedLinked; 631end; 632 633{------------------------------------------------------------------------------ 634 function TMenuItem.IsEnabledStored: boolean; 635 636 Checks if 'Enabled' needs to be saved to stream 637 ------------------------------------------------------------------------------} 638function TMenuItem.IsEnabledStored: boolean; 639begin 640 Result := (ActionLink = nil) or not FActionLink.IsEnabledLinked; 641end; 642 643function TMenuItem.IsHelpContextStored: boolean; 644begin 645 Result := (ActionLink = nil) or not FActionLink.IsHelpContextLinked; 646end; 647 648function TMenuItem.IsHintStored: Boolean; 649begin 650 Result := (ActionLink = nil) or not FActionLink.IsHintLinked; 651end; 652 653function TMenuItem.IsImageIndexStored: Boolean; 654begin 655 Result := (ActionLink = nil) or not FActionLink.IsImageIndexLinked; 656end; 657 658{------------------------------------------------------------------------------ 659 function TMenuItem.IsShortCutStored: boolean; 660 661 Checks if 'ShortCut' needs to be saved to stream 662 ------------------------------------------------------------------------------} 663function TMenuItem.IsShortCutStored: boolean; 664begin 665 Result := (ActionLink = nil) or not FActionLink.IsShortCutLinked; 666end; 667 668{------------------------------------------------------------------------------ 669 function TMenuItem.IsVisibleStored: boolean; 670 671 Checks if 'Visible' needs to be saved to stream 672 ------------------------------------------------------------------------------} 673function TMenuItem.IsVisibleStored: boolean; 674begin 675 Result := (ActionLink = nil) or not FActionLink.IsVisibleLinked; 676end; 677 678{------------------------------------------------------------------------------ 679 procedure TMenuItem.SetAutoCheck(const AValue: boolean); 680 681 If user clicks, toggle 'Checked' 682 ------------------------------------------------------------------------------} 683procedure TMenuItem.SetAutoCheck(const AValue: boolean); 684var 685 OldIsCheckItem: boolean; 686begin 687 if FAutoCheck = AValue then exit; 688 OldIsCheckItem := IsCheckItem; 689 FAutoCheck := AValue; 690 if (OldIsCheckItem<>IsCheckItem) and (HandleAllocated) then 691 RecreateHandle; 692end; 693 694{------------------------------------------------------------------------------ 695 Function: TMenuItem.GetParentMenu 696 Params: none 697 Returns: The (popup)menu containing this item. 698 699 700 ------------------------------------------------------------------------------} 701function TMenuItem.GetParentMenu: TMenu; 702var 703 Item: TMenuItem; 704begin 705 Item := Self; 706 while Item.Parent <> nil do Item := Item.Parent; 707 Result := Item.FMenu; 708end; 709 710{------------------------------------------------------------------------------ 711 Function: TMenuItem.GetIsRightToLeft 712 Returns: Get IsRightToLeft value from Menu 713 714 ------------------------------------------------------------------------------} 715 716function TMenuItem.GetIsRightToLeft: Boolean; 717var 718 LMenu:TMenu; 719begin 720 LMenu := GetParentMenu; 721 Result := (LMenu <> nil) and (LMenu.IsRightToLeft); 722end; 723 724{------------------------------------------------------------------------------ 725 Function: TMenuItem.HandleAllocated 726 Params: None 727 Returns: True is handle is allocated 728 729 Checks if a handle is allocated. I.E. if the control is created 730 ------------------------------------------------------------------------------} 731function TMenuItem.HandleAllocated : Boolean; 732begin 733 HandleAllocated := (FHandle <> 0); 734end; 735 736{------------------------------------------------------------------------------ 737 Method: TMenuItem.HandleNeeded 738 Params: AOwner: the owner of the class 739 Returns: Nothing 740 741 Description of the procedure for the class. 742 ------------------------------------------------------------------------------} 743procedure TMenuItem.HandleNeeded; 744begin 745 if not HandleAllocated then CreateHandle; 746end; 747 748function SystemShowMenuGlyphs: Boolean; inline; 749begin 750 Result := ThemeServices.GetOption(toShowMenuImages) = 1; 751end; 752 753{------------------------------------------------------------------------------ 754 function TMenuItem.HasIcon: boolean; 755 756 Returns true if there is an icon 757 ------------------------------------------------------------------------------} 758function TMenuItem.HasIcon: boolean; 759 760 function CanShowIcon: Boolean; 761 begin 762 Result := True; 763 if csDesigning in ComponentState then 764 Exit; 765 case GlyphShowMode of 766 gsmAlways: 767 Result := True; 768 gsmNever: 769 Result := False; 770 gsmApplication: 771 begin 772 case Application.ShowMenuGlyphs of 773 sbgAlways: Result := True; 774 sbgNever: Result := False; 775 sbgSystem: Result := SystemShowMenuGlyphs; 776 end; 777 end; 778 gsmSystem: 779 Result := SystemShowMenuGlyphs; 780 end; 781 end; 782 783var 784 AImageList: TCustomImageList; 785 AImageListWidth: Integer; 786begin 787 Result := CanShowIcon; 788 if not Result then 789 Exit; 790 GetImageList(AImageList, AImageListWidth); 791 Result := (AImageList <> nil) and (ImageIndex >= 0) and (ImageIndex < AImageList.Count); 792 if not Result then 793 Result := (FBitmap <> nil) and not FBitmap.Empty; 794end; 795 796{------------------------------------------------------------------------------ 797 procedure TMenuItem.DestroyHandle; 798 799 Free the Handle 800 ------------------------------------------------------------------------------} 801procedure TMenuItem.DestroyHandle; 802var 803 i: integer; 804begin 805 if not HandleAllocated then Exit; 806 //DebugLn('TMenuItem.DestroyHandle ',dbgsName(Self),' ',dbgs(Self)); 807 if Assigned(FItems) then 808 begin 809 for i := FItems.Count - 1 downto 0 do 810 TMenuItem(FItems[i]).DestroyHandle; 811 end; 812 if Assigned(FMerged) then 813 for i := FMerged.Count - 1 downto 0 do 814 FMerged[i].DestroyHandle; 815 TWSMenuItemClass(WidgetSetClass).DestroyHandle(Self); 816 FHandle := 0; 817end; 818 819procedure TMenuItem.Loaded; 820begin 821 inherited Loaded; 822 if Action <> nil then ActionChange(Action, True); 823end; 824 825procedure TMenuItem.Notification(AComponent: TComponent; Operation: TOperation); 826begin 827 inherited Notification(AComponent, Operation); 828 if Operation = opRemove then 829 if AComponent = Action then 830 Action := nil 831 else 832 if AComponent = FSubMenuImages then 833 SubMenuImages := nil 834 {else if AComponent = FMerged then 835 MergeWith(nil)}; 836end; 837 838{------------------------------------------------------------------------------ 839 procedure TMenuItem.RecreateHandle; 840 841 Destroy and re-Create handle. This is done, when the type or the context 842 of the TMenuItem is changed. 843 ------------------------------------------------------------------------------} 844procedure TMenuItem.RecreateHandle; 845begin 846 if not HandleAllocated then Exit; 847 DestroyHandle; 848 HandleNeeded; 849end; 850 851{------------------------------------------------------------------------------ 852 Method: TMenuItem.HasParent 853 Params: 854 Returns: True - the item has a parent responsible for streaming 855 856 ------------------------------------------------------------------------------} 857function TMenuItem.HasParent : Boolean; 858begin 859 Result := Assigned(FParent); 860end; 861 862procedure TMenuItem.InitiateAction; 863begin 864 if FActionLink <> nil then FActionLink.Update; 865end; 866 867{------------------------------------------------------------------------------ 868 Method: TMenuItem.Insert 869 Params: Index: Location of the menuitem to insert 870 Item: Menu item to insert 871 Returns: Nothing 872 873 Inserts a menu child at the given index position. 874 ------------------------------------------------------------------------------} 875procedure TMenuItem.Insert(Index: Integer; Item: TMenuItem); 876begin 877 if (Item = nil) then exit; 878 if Item.Parent <> nil then 879 RaiseGDBException('Menu inserted twice'); 880 881 // create Items if needed 882 if FItems = nil then FItems := TMenuItems.Create(Self); 883 884 // adjust GroupIndex 885 (* 886 * MWE: Disabled this feature, it makes not much sense 887 * suppose a menu with items grouped like : G=2, G=2, ---, G=1, G=1 888 * where --- is separator with G=0 889 * Inserting G=1 after --- is OK according to the next check 890 891 if (Index>0) and (Index < FItems.Count) then 892 if Item.GroupIndex < TMenuItem(FItems[Index - 1]).GroupIndex then 893 Item.GroupIndex := TMenuItem(FItems[Index - 1]).GroupIndex; 894 VerifyGroupIndex(Index, Item.GroupIndex); 895 *) 896 897 Item.FParent := Self; 898 Item.FOnChange := @SubItemChanged; 899 FItems.Insert(Index, Item); 900 901 if HandleAllocated and Item.Visible then 902 Item.HandleNeeded; 903 MenuChanged(FItems.Count = 1); 904end; 905 906{------------------------------------------------------------------------------ 907 Function:TMenuItem.IndexOf 908 Params: Item: The index requested for. 909 Returns: Nothing 910 911 Returns the index of the menuitem. 912 ------------------------------------------------------------------------------} 913function TMenuItem.IndexOf(Item: TMenuItem): Integer; 914begin 915 if FItems = nil then 916 Result := -1 917 else 918 Result := FItems.IndexOf(Item); 919end; 920 921{------------------------------------------------------------------------------ 922 function TMenuItem.IndexOfCaption(const ACaption: string): Integer; 923 924 Returns the index of the menuitem with the given caption or -1 925 ------------------------------------------------------------------------------} 926function TMenuItem.IndexOfCaption(const ACaption: string): Integer; 927begin 928 for Result := 0 to Count - 1 do 929 if Items[Result].Caption = ACaption then Exit; 930 Result := -1; 931end; 932 933{------------------------------------------------------------------------------ 934 function TMenuItem.VisibleIndexOf(Item: TMenuItem): Integer; 935 936 Returns the index of the menuitem of all visible menuitems 937 ------------------------------------------------------------------------------} 938function TMenuItem.VisibleIndexOf(Item: TMenuItem): Integer; 939var 940 i: Integer; 941 CurMenuItem: TMenuItem; 942 IsMerged: Boolean; 943 AMergedItems: TMergedMenuItems; 944begin 945 if not Item.Visible then 946 Exit(-1); 947 AMergedItems := GetMergedItems; 948 for I := 0 to AMergedItems.VisibleCount-1 do 949 if AMergedItems.VisibleItems[I]=Item then 950 Exit(I); 951 Result := -1; 952end; 953 954{------------------------------------------------------------------------------ 955 Method: TMenuItem.MenuChanged 956 Params: Rebuild : Boolean 957 Returns: Nothing 958 959 ------------------------------------------------------------------------------} 960procedure TMenuItem.MenuChanged(Rebuild : Boolean); 961var 962 Source: TMenuItem; 963begin 964 if (Parent = nil) and (Owner is TMenu) then 965 Source := nil 966 else 967 Source := Self; 968 if Assigned(FOnChange) then FOnChange(Self, Source, Rebuild); 969end; 970 971{------------------------------------------------------------------------------ 972 procedure TMenuItem.SetChildOrder(Child: TComponent; Order: Integer); 973 974 Reposition the MenuItem 975 ------------------------------------------------------------------------------} 976procedure TMenuItem.SetChildOrder(Child: TComponent; Order: Integer); 977begin 978 (Child as TMenuItem).MenuIndex := Order; 979end; 980 981{------------------------------------------------------------------------------ 982 procedure TMenuItem.Remove(Item: TMenuItem); 983 984 985 ------------------------------------------------------------------------------} 986procedure TMenuItem.Remove(Item: TMenuItem); 987var 988 I: Integer; 989begin 990 I := IndexOf(Item); 991 if I < 0 then 992 raise EMenuError.Create(SMenuNotFound); 993 Delete(I); 994end; 995 996{------------------------------------------------------------------------------ 997 function TMenuItem.IsInMenuBar: boolean; 998 ------------------------------------------------------------------------------} 999function TMenuItem.IsInMenuBar: boolean; 1000var 1001 AMergedParent: TMenuItem; 1002begin 1003 AMergedParent := MergedParent; 1004 Result := (AMergedParent <> nil) and (AMergedParent.FMenu <> nil) and (AMergedParent.FMenu is TMainMenu); 1005end; 1006 1007{------------------------------------------------------------------------------ 1008 procedure TMenuItem.Clear; 1009 1010 Deletes all children 1011 ------------------------------------------------------------------------------} 1012procedure TMenuItem.Clear; 1013var 1014 I: Integer; 1015begin 1016 for I := Count - 1 downto 0 do 1017 Items[I].Free; 1018end; 1019 1020function TMenuItem.HasBitmap: boolean; 1021begin 1022 Result := FBitmap <> nil; 1023end; 1024 1025{------------------------------------------------------------------------------ 1026 function TMenuItem.GetIconSize: TPoint; 1027 ------------------------------------------------------------------------------} 1028function TMenuItem.GetIconSize(ADC: HDC): TPoint; 1029var 1030 AImageList: TCustomImageList; 1031 PPI, AImageListWidth: Integer; 1032 Size: TSize; 1033begin 1034 FillChar(Result, SizeOf(Result), 0); 1035 if HasIcon then 1036 begin 1037 GetImageList(AImageList, AImageListWidth); 1038 if (AImageList <> nil) and (FImageIndex >= 0) then // using size of ImageList 1039 begin 1040 if (FImageIndex >= AImageList.Count) then 1041 Exit; 1042 PPI := GetDeviceCaps(ADC, LOGPIXELSX); 1043 Size := AImageList.SizeForPPI[AImageListWidth, PPI]; 1044 Result.x := Size.cx; 1045 Result.y := Size.cy; 1046 end 1047 else // using size of Bitmap 1048 begin 1049 Result.x := Bitmap.Width; 1050 Result.y := Bitmap.Height; 1051 end; 1052 end; 1053end; 1054 1055procedure TMenuItem.RemoveAllHandlersOfObject(AnObject: TObject); 1056var 1057 HandlerType: TMenuItemHandlerType; 1058begin 1059 inherited RemoveAllHandlersOfObject(AnObject); 1060 for HandlerType := Low(TMenuItemHandlerType) to High(TMenuItemHandlerType) do 1061 FMenuItemHandlers[HandlerType].RemoveAllMethodsOfObject(AnObject); 1062end; 1063 1064procedure TMenuItem.AddHandlerOnDestroy(const OnDestroyEvent: TNotifyEvent; 1065 AsFirst: boolean); 1066begin 1067 AddHandler(mihtDestroy, TMethod(OnDestroyEvent),not AsFirst); 1068end; 1069 1070procedure TMenuItem.RemoveHandlerOnDestroy(const OnDestroyEvent: TNotifyEvent); 1071begin 1072 RemoveHandler(mihtDestroy, TMethod(OnDestroyEvent)); 1073end; 1074 1075procedure TMenuItem.AddHandler(HandlerType: TMenuItemHandlerType; 1076 const AMethod: TMethod; AsFirst: boolean); 1077begin 1078 if FMenuItemHandlers[HandlerType] = nil then 1079 FMenuItemHandlers[HandlerType] := TMethodList.Create; 1080 FMenuItemHandlers[HandlerType].Add(AMethod,not AsFirst); 1081end; 1082 1083procedure TMenuItem.RemoveHandler(HandlerType: TMenuItemHandlerType; 1084 const AMethod: TMethod); 1085begin 1086 FMenuItemHandlers[HandlerType].Remove(AMethod); 1087end; 1088 1089function TMenuItem.MenuVisibleIndex: integer; 1090begin 1091 Result:=-1; 1092 if Parent=nil then 1093 Result:=-1 1094 else 1095 Result:=Parent.VisibleIndexOf(Self); 1096end; 1097 1098procedure TMenuItem.MergeWith(const aMenu: TMenuItem); 1099var 1100 i: Integer; 1101begin 1102 if (Assigned(aMenu) and (csDestroying in aMenu.ComponentState)) 1103 or (FMerged=aMenu) then 1104 Exit; 1105 1106 if Assigned(FMerged) then 1107 begin 1108 for i := 0 to FMerged.Count-1 do 1109 FMerged[i].DestroyHandle; 1110 FMerged.FMergedWith := nil; 1111 end; 1112 FMerged := aMenu; 1113 if Assigned(FMerged) then 1114 begin 1115 FMerged.FMergedWith := Self; 1116 FMerged.FreeNotification(Self); 1117 end; 1118 InvalidateMergedItems; 1119 CheckChildrenHandles; 1120end; 1121 1122procedure TMenuItem.WriteDebugReport(const Prefix: string); 1123var 1124 Flags: String; 1125 i: Integer; 1126begin 1127 Flags:=''; 1128 if Visible then Flags:=Flags+'V'; 1129 if Enabled then Flags:=Flags+'E'; 1130 if RadioItem then Flags:=Flags+'R'; 1131 if Checked then Flags:=Flags+'C'; 1132 if HandleAllocated then Flags:=Flags+'H'; 1133 DbgOut(Prefix,' Name="',Name,'" Caption="',DbgStr(Caption),'" Flags=',Flags); 1134 if Parent<>nil then 1135 DbgOut(' ',dbgs(MenuIndex),'/',dbgs(Parent.Count)); 1136 DebugLn(''); 1137 for i:=0 to Count-1 do 1138 Items[i].WriteDebugReport(Prefix+' '); 1139end; 1140 1141{------------------------------------------------------------------------------ 1142 function TMenuItem.IsCheckItem: boolean; 1143 1144 Results true if 'Checked' or 'RadioItem' or 'AutoCheck' 1145 or 'ShowAlwaysCheckable' 1146 ------------------------------------------------------------------------------} 1147function TMenuItem.IsCheckItem: boolean; 1148begin 1149 Result := Checked or RadioItem or AutoCheck or ShowAlwaysCheckable; 1150end; 1151 1152 1153{ Returns true if the current menu item is a Line (menu seperator). Added for 1154 Delphi compatability as well. } 1155function TMenuItem.IsLine: Boolean; 1156begin 1157 Result := FCaption = cLineCaption; 1158end; 1159 1160 1161{------------------------------------------------------------------------------ 1162 Method: TMenuItem.SetCaption 1163 Params: Value: 1164 Returns: Nothing 1165 1166 Sets the caption of a menuItem. 1167 ------------------------------------------------------------------------------} 1168procedure TMenuItem.SetCaption(const AValue: TTranslateString); 1169begin 1170 if FCaption = AValue then exit; 1171 FCaption := AValue; 1172 if HandleAllocated and ((Parent <> nil) or (FMenu = nil)) then 1173 TWSMenuItemClass(WidgetSetClass).SetCaption(Self, AValue); 1174 OwnerFormDesignerModified(Self); 1175end; 1176 1177{------------------------------------------------------------------------------ 1178 Method: TMenuItem.SetChecked 1179 Params: Value: 1180 Returns: Nothing 1181 1182 Places a checkmark in front of the label. 1183 ------------------------------------------------------------------------------} 1184procedure TMenuItem.SetChecked(AValue: Boolean); 1185begin 1186 if FChecked <> AValue then 1187 begin 1188 FChecked := AValue; 1189 if AValue and FRadioItem then 1190 TurnSiblingsOff; 1191 if (FParent <> nil) and not (csReading in ComponentState) and HandleAllocated then 1192 TWSMenuItemClass(WidgetSetClass).SetCheck(Self, AValue); 1193 OwnerFormDesignerModified(Self); 1194 end; 1195end; 1196 1197{------------------------------------------------------------------------------ 1198 Method: TMenuItem.SetDefault 1199 Params: Value: 1200 Returns: Nothing 1201 1202 Makes a menuItem the default item (BOLD). 1203 ------------------------------------------------------------------------------} 1204procedure TMenuItem.SetDefault(AValue: Boolean); 1205begin 1206 FDefault := AValue; 1207 //TODO: Add runtime code here 1208end; 1209 1210{------------------------------------------------------------------------------ 1211 Method: TMenuItem.SetEnabled 1212 Params: Value: 1213 Returns: Nothing 1214 1215 Enables a menuItem. 1216 ------------------------------------------------------------------------------} 1217procedure TMenuItem.SetEnabled(AValue: Boolean); 1218begin 1219 if FEnabled <> AValue then 1220 begin 1221 FEnabled := AValue; 1222 if HandleAllocated and (Parent <> nil) then 1223 TWSMenuItemClass(WidgetSetClass).SetEnable(Self, AValue); 1224 MenuChanged(False); 1225 end; 1226end; 1227 1228{------------------------------------------------------------------------------ 1229 procedure TMenuItem.SetBitmap(const AValue: TBitmap); 1230 1231 Reposition the MenuItem 1232 ------------------------------------------------------------------------------} 1233procedure TMenuItem.SetBitmap(const AValue: TBitmap); 1234begin 1235 // ImageList have highest priority 1236 if (FBitmap = AValue) or ((GetImageList <> nil) and (ImageIndex <> -1)) then 1237 exit; 1238 1239 FBitmapIsValid := True; 1240 if (AValue <> nil) then 1241 Bitmap.Assign(AValue) 1242 else 1243 FreeAndNil(FBitmap); 1244 1245 UpdateWSIcon; 1246 MenuChanged(False); 1247end; 1248 1249procedure TMenuItem.SetGlyphShowMode(const AValue: TGlyphShowMode); 1250begin 1251 if FGlyphShowMode = AValue then Exit; 1252 FGlyphShowMode := AValue; 1253 UpdateImage; 1254end; 1255 1256{------------------------------------------------------------------------------ 1257 procedure TMenuItem.SetMenuIndex(const AValue: Integer); 1258 1259 Reposition the MenuItem 1260 ------------------------------------------------------------------------------} 1261procedure TMenuItem.SetMenuIndex(AValue: Integer); 1262var 1263 OldParent: TMenuItem; 1264 ParentCount: Integer; 1265begin 1266 if FParent <> nil then 1267 begin 1268 ParentCount := FParent.Count; 1269 if AValue < 0 then 1270 AValue := 0; 1271 if AValue >= ParentCount then 1272 AValue := ParentCount - 1; 1273 if AValue <> MenuIndex then 1274 begin 1275 OldParent := FParent; 1276 OldParent.Remove(Self); 1277 OldParent.Insert(AValue, Self); 1278 end; 1279 end; 1280end; 1281 1282procedure TMenuItem.SetName(const Value: TComponentName); 1283var 1284 ChangeCapt: Boolean; 1285begin 1286 if Name=Value then exit; 1287 ChangeCapt := not (csLoading in ComponentState) and (Name = Caption) and 1288 ( (Owner = nil) or not (csLoading in Owner.ComponentState) ); 1289 inherited SetName(Value); 1290 if ChangeCapt then 1291 Caption := Value; 1292end; 1293 1294{------------------------------------------------------------------------------ 1295 procedure TMenuItem.SetRadioItem(const AValue: Boolean); 1296 1297 Sets the 'RadioItem' property of the group of menuitems with the same 1298 GroupIndex. If RadioItem is true only one menuitem is checked at a time. 1299 ------------------------------------------------------------------------------} 1300procedure TMenuItem.SetRadioItem(const AValue: Boolean); 1301var 1302 i: integer; 1303 Item: TMenuItem; 1304begin 1305 if FRadioItem <> AValue then 1306 begin 1307 FRadioItem := AValue; 1308 if FChecked and FRadioItem then 1309 TurnSiblingsOff; 1310 if (GroupIndex<>0) and (FParent<>nil) then 1311 begin 1312 for I := 0 to FParent.Count - 1 do 1313 begin 1314 Item := FParent[I]; 1315 if (Item <> Self) and (Item.GroupIndex = GroupIndex) then 1316 Item.FRadioItem := FRadioItem; 1317 end; 1318 end; 1319 if (FParent <> nil) and not (csReading in ComponentState) and (HandleAllocated) then 1320 TWSMenuItemClass(WidgetSetClass).SetRadioItem(Self, AValue); 1321 end; 1322end; 1323 1324{------------------------------------------------------------------------------ 1325 procedure TMenuItem.SetRightJustify(const AValue: boolean); 1326 1327 Enables a menuItem. 1328 ------------------------------------------------------------------------------} 1329procedure TMenuItem.SetRightJustify(const AValue: boolean); 1330begin 1331 if FRightJustify = AValue then Exit; 1332 FRightJustify := AValue; 1333 if HandleAllocated then 1334 TWSMenuItemClass(WidgetSetClass).SetRightJustify(Self, AValue); 1335end; 1336 1337{------------------------------------------------------------------------------ 1338 procedure TMenuItem.SetShowAlwaysCheckable(const AValue: boolean); 1339 1340 Reserve place for check icon, even if not 'Checked' 1341 ------------------------------------------------------------------------------} 1342procedure TMenuItem.SetShowAlwaysCheckable(const AValue: boolean); 1343var 1344 OldIsCheckItem: boolean; 1345begin 1346 if FShowAlwaysCheckable=AValue then exit; 1347 OldIsCheckItem:=IsCheckItem; 1348 FShowAlwaysCheckable:=AValue; 1349 if (OldIsCheckItem<>IsCheckItem) and (HandleAllocated) then 1350 RecreateHandle; 1351end; 1352 1353{------------------------------------------------------------------------------ 1354 procedure TMenuItem.SetSubMenuImages(const AValue: TCustomImageList); 1355 1356 Sets the new sub images list 1357 ------------------------------------------------------------------------------} 1358procedure TMenuItem.SetSubMenuImages(const AValue: TCustomImageList); 1359begin 1360 if FSubMenuImages <> nil then 1361 begin 1362 FSubMenuImages.UnRegisterChanges(FImageChangeLink); 1363 FSubMenuImages.RemoveFreeNotification(Self); 1364 end; 1365 FSubMenuImages := AValue; 1366 if FSubMenuImages <> nil then 1367 begin 1368 FSubMenuImages.RegisterChanges(FImageChangeLink); 1369 FSubMenuImages.FreeNotification(Self); 1370 end; 1371 UpdateImages; 1372end; 1373 1374procedure TMenuItem.SetSubMenuImagesWidth(const aSubMenuImagesWidth: Integer); 1375begin 1376 if FSubMenuImagesWidth = aSubMenuImagesWidth then Exit; 1377 FSubMenuImagesWidth := aSubMenuImagesWidth; 1378 UpdateImages; 1379end; 1380 1381{------------------------------------------------------------------------------ 1382 Method: TMenuItem.SetImageIndex 1383 Params: Value: 1384 Returns: Nothing 1385 1386 Enables a menuItem. 1387 ------------------------------------------------------------------------------} 1388procedure TMenuItem.SetImageIndex(AValue: TImageIndex); 1389var 1390 AImageList: TCustomImageList; 1391begin 1392 if (FImageIndex = AValue) then 1393 Exit; 1394 //debugln(['TMenuItem.SetImageIndex A ',Name,' Old=',FImageIndex,' New=',AValue]); 1395 AImageList := GetImageList; 1396 FImageIndex := AValue; 1397 if AImageList = nil then 1398 Exit; 1399 1400 FBitmapIsValid := False; 1401 if (FImageIndex < 0) or (AImageList = nil) or (FImageIndex >= AImageList.Count) then 1402 FreeAndNil(FBitmap); 1403 1404 UpdateWSIcon; 1405 MenuChanged(False); 1406end; 1407 1408{------------------------------------------------------------------------------ 1409 Method: TMenuItem.SetParentComponent 1410 Params: Value: 1411 Returns: Nothing 1412 1413 Enables a menuItem. 1414 ------------------------------------------------------------------------------} 1415procedure TMenuItem.SetParentComponent(AValue : TComponent); 1416begin 1417 if (FParent = AValue) then exit; 1418 1419 if Assigned(FParent) then 1420 FParent.Remove(Self); 1421 1422 if assigned (AValue) then 1423 begin 1424 if (AValue is TMenu) 1425 then TMenu(AValue).Items.Add(Self) 1426 else if (AValue is TMenuItem) 1427 then TMenuItem(AValue).Add(Self) 1428 else 1429 raise Exception.Create('TMenuItem.SetParentComponent: suggested parent not of type TMenu or TMenuItem'); 1430 end; 1431end; 1432 1433{------------------------------------------------------------------------------ 1434 Method: TMenuItem.SetGroupIndex 1435 Params: Value: Byte 1436 Returns: Nothing 1437 1438 Set the GroupIndex 1439 ------------------------------------------------------------------------------} 1440procedure TMenuItem.SetGroupIndex(AValue: Byte); 1441begin 1442 if FGroupIndex <> AValue then 1443 begin 1444 (* 1445 * MWE: Disabled this feature, it makes not much sense 1446 * See other comments 1447 if Parent <> nil then 1448 Parent.VerifyGroupIndex(Parent.IndexOf(Self), AValue); 1449 *) 1450 FGroupIndex := AValue; 1451 if FChecked and FRadioItem then 1452 TurnSiblingsOff; 1453 // tell the interface to regroup this menuitem 1454 if HandleAllocated and not (csLoading in ComponentState) then 1455 RegroupMenuItem(Handle,GroupIndex); 1456 end; 1457end; 1458 1459{------------------------------------------------------------------------------ 1460 Method: TMenuItem.SetShortCut 1461 Params: Value: TShortCut 1462 Returns: Nothing 1463 1464 Set the ShortCut 1465 ------------------------------------------------------------------------------} 1466procedure TMenuItem.SetShortCut(const AValue : TShortCut); 1467Begin 1468 if FShortCut <> AValue then 1469 begin 1470 FShortCut := AValue; 1471 ShortCutChanged; 1472 end; 1473end; 1474 1475procedure TMenuItem.SetShortCutKey2(const AValue: TShortCut); 1476begin 1477 if FShortCutKey2 <> AValue then 1478 begin 1479 FShortCutKey2 := AValue; 1480 ShortCutChanged; 1481 end; 1482end; 1483 1484{------------------------------------------------------------------------------ 1485 Method: TMenuItem.SetVisible 1486 Params: Value: Visibility 1487 Returns: Nothing 1488 1489 Description of the procedure for the class. 1490 ------------------------------------------------------------------------------} 1491procedure TMenuItem.SetVisible(AValue: Boolean); 1492begin 1493 if FVisible = AValue then Exit; 1494 //debugln('TMenuItem.SetVisible ',dbgsname(Self),' NewValue=',dbgs(AValue),' HandleAllocated=',dbgs(HandleAllocated)); 1495 if ([csDestroying] * ComponentState <> []) then Exit; 1496 if AValue then 1497 begin 1498 FVisible := AValue; 1499 if (not (csLoading in ComponentState)) and (Parent<>nil) 1500 and Parent.HandleAllocated then 1501 HandleNeeded; 1502 if HandleAllocated then 1503 TWSMenuItemClass(WidgetSetClass).SetVisible(Self, True); 1504 end else 1505 begin 1506 if HandleAllocated then 1507 begin 1508 TWSMenuItemClass(WidgetSetClass).SetVisible(Self, False); 1509 DestroyHandle; 1510 end; 1511 FVisible := AValue; 1512 end; 1513 if MergedParent<>nil then 1514 MergedParent.InvalidateMergedItems; 1515end; 1516 1517procedure TMenuItem.UpdateImage(forced: Boolean); 1518var 1519 ImgList: TCustomImageList; 1520begin 1521 if [csLoading, csDestroying] * ComponentState = [] then 1522 begin 1523 ImgList := GetImageList; 1524 if FBitmapIsValid then // Bitmap is assigned through Bitmap property 1525 begin 1526 if (ImgList <> nil) and (ImageIndex <> -1) then 1527 begin 1528 FreeAndNil(FBitmap); 1529 FBitmapIsValid := False; 1530 end; 1531 end 1532 else 1533 begin 1534 if (forced) or (ImgList = nil) or (ImageIndex = -1) then 1535 begin 1536 FreeAndNil(FBitmap); 1537 FBitmapIsValid := True; 1538 end; 1539 end; 1540 if HandleAllocated then 1541 UpdateWSIcon; 1542 end; 1543end; 1544 1545procedure TMenuItem.UpdateImages(forced: Boolean); 1546var 1547 i: integer; 1548begin 1549 if HandleAllocated and ([csLoading,csDestroying]*ComponentState=[]) then 1550 begin 1551 UpdateImage(forced); 1552 for i := 0 to Count - 1 do 1553 Items[i].UpdateImages(forced); 1554 end; 1555end; 1556 1557procedure TMenuItem.UpdateWSIcon; 1558begin 1559 if HandleAllocated then 1560 if HasIcon then // prevent creating bitmap 1561 TWSMenuItemClass(WidgetSetClass).UpdateMenuIcon(Self, HasIcon, Bitmap) 1562 else 1563 TWSMenuItemClass(WidgetSetClass).UpdateMenuIcon(Self, HasIcon, nil); 1564end; 1565 1566procedure TMenuItem.ImageListChange(Sender: TObject); 1567begin 1568 if Sender = SubMenuImages then 1569 UpdateImages; 1570end; 1571 1572{------------------------------------------------------------------------------ 1573 Method: TMenuItem.ShortcutChanged 1574 Params: OldValue: Old shortcut, Value: New shortcut 1575 Returns: Nothing 1576 1577 Installs a new shortCut, removes an old one. 1578 ------------------------------------------------------------------------------} 1579procedure TMenuItem.ShortcutChanged; 1580begin 1581 if HandleAllocated then 1582 TWSMenuItemClass(WidgetSetClass).SetShortCut(Self, FShortCut, FShortCutKey2); 1583end; 1584 1585{------------------------------------------------------------------------------ 1586 procedure TMenuItem.SubItemChanged(Sender: TObject; Source: TMenuItem; 1587 Rebuild: Boolean); 1588 1589 Is Called whenever one of the children has changed. 1590 ------------------------------------------------------------------------------} 1591procedure TMenuItem.SubItemChanged(Sender: TObject; Source: TMenuItem; 1592 Rebuild: Boolean); 1593begin 1594 if Rebuild and HandleAllocated then 1595 ; //RebuildHandle; 1596 if Parent <> nil then 1597 Parent.SubItemChanged(Self, Source, False) 1598 else if Owner is TMainMenu then 1599 TMainMenu(Owner).ItemChanged; 1600end; 1601 1602{------------------------------------------------------------------------------ 1603 Method: TMenuItem.TurnSiblingsOff 1604 Params: none 1605 Returns: Nothing 1606 1607 Unchecks all siblings. 1608 In contrary to Delphi this will not use SetChecked, because this is up to the 1609 interface. This procedure just sets the private variables. 1610 1611 //todo 1612 MWE: ??? shouldn't we get checked from the interface in that case ??? 1613 ------------------------------------------------------------------------------} 1614procedure TMenuItem.TurnSiblingsOff; 1615var 1616 I: Integer; 1617 Item: TMenuItem; 1618begin 1619 if Assigned(FParent) then 1620 for I := 0 to FParent.Count - 1 do 1621 begin 1622 Item := FParent[I]; 1623 if (Item <> Self) and Item.FRadioItem and (Item.GroupIndex = GroupIndex) then 1624 Item.FChecked := False; 1625 end; 1626end; 1627 1628procedure TMenuItem.DoActionChange(Sender: TObject); 1629begin 1630 if Sender = Action then ActionChange(Sender, False); 1631end; 1632 1633class procedure TMenuItem.WSRegisterClass; 1634begin 1635 inherited WSRegisterClass; 1636 RegisterMenuItem; 1637end; 1638 1639procedure TMenuItem.AssignTo(Dest: TPersistent); 1640begin 1641 if Dest is TCustomAction then 1642 begin 1643 with TCustomAction(Dest) do 1644 begin 1645 Caption := Self.Caption; 1646 Enabled := Self.Enabled; 1647 HelpContext := Self.HelpContext; 1648 Hint := Self.Hint; 1649 ImageIndex := Self.ImageIndex; 1650 Visible := Self.Visible; 1651 end 1652 end 1653 else 1654 if Dest is TMenuItem then 1655 MenuItem_Copy(Self, Dest as TMenuItem) 1656 else 1657 inherited AssignTo(Dest); 1658end; 1659 1660procedure TMenuItem.BitmapChange(Sender: TObject); 1661begin 1662 UpdateImage; 1663end; 1664 1665// included by menus.pp 1666