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