diff --git a/lcl/include/menu.inc b/lcl/include/menu.inc index 680583a2b5..6a3e7814e2 100644 --- a/lcl/include/menu.inc +++ b/lcl/include/menu.inc @@ -22,6 +22,7 @@ constructor TMenu.Create(AOwner: TComponent); begin FItems := TMenuItem.Create(Self); + FItems.FAutoLineReduction := maAutomatic; FItems.FOnChange := @MenuChanged; FItems.FMenu := Self; FImageChangeLink := TChangeLink.Create; @@ -93,6 +94,14 @@ begin FItems.UpdateImages; end; +function TMenu.GetAutoLineReduction: TMenuAutoFlag; +begin + case FItems.AutoLineReduction of + maParent, maAutomatic: Result := maAutomatic; //cannot return maParent for TMenu.AutoLineReduction + maManual: Result := maManual; + end; +end; + procedure TMenu.BidiModeChanged; begin if HandleAllocated then @@ -140,6 +149,11 @@ begin if Sender = Images then UpdateItems; end; +procedure TMenu.SetAutoLineReduction(AValue: TMenuAutoFlag); +begin + FItems.AutoLineReduction := AValue; +end; + {------------------------------------------------------------------------------ Method: TMenu.CreateHandle Params: None diff --git a/lcl/include/menuitem.inc b/lcl/include/menuitem.inc index f802dbc34d..0349fae739 100644 --- a/lcl/include/menuitem.inc +++ b/lcl/include/menuitem.inc @@ -115,6 +115,7 @@ begin FRightJustify := False; FShowAlwaysCheckable := False; FGlyphShowMode := gsmApplication; + FAutoLineReduction := maParent; FImageChangeLink := TChangeLink.Create; FImageChangeLink.OnChange := @ImageListChange; @@ -342,6 +343,69 @@ begin end; end; +function TMenuItem.InternalRethinkLines(AForced: Boolean): Boolean; +var + LItem: TMenuItem; + LLastVisibleIsLine, HideSeps: Boolean; + LLastVisibleItem: TMenuItem; + I: Integer; +begin + debugln(['TMenuItem.InternalRethinkLines, AForced=',AForced]); + Result := False; + if (csDesigning in ComponentState) then + Exit; + HideSeps := GetAutoLineReduction; + if {AForced or} HideSeps then + begin + LLastVisibleIsLine := True; // to hide head line + LLastVisibleItem := nil; + + for I:= 0 to Count - 1 do + begin + LItem := Items[I]; + if LItem.IsLine then + begin + // hide head or double lines + if LItem.Visible <> not LLastVisibleIsLine then + begin + LItem.Visible := not LLastVisibleIsLine; + Result := True; + debugln(['TMenuItem.InternalRethinkLines: hiding separator with name "',LItem.Name,'"']); + end; + end; + + if LItem.Visible then + begin + LLastVisibleIsLine := LItem.IsLine; + LLastVisibleItem := LItem; + end; + end; + + // hide end line + if (LLastVisibleItem <> nil) and + LLastVisibleItem.IsLine and LLastVisibleItem.Visible then + begin + LLastVisibleItem.Visible := False; + Result := True; + debugln(['TMenuItem.InternalRethinkLines: hiding separator with name "',LItem.Name,'"']); + end; + end + else + //apparently if GetAToLineReduction is False, Delphi sets all separators to be visible + begin + for i := 0 to Count - 1 do + begin + LItem := Items[i]; + if LItem.IsLine and not LItem.Visible then + begin + LItem.Visible := True; + Result := True; + debugln(['TMenuItem.InternalRethinkLines: unhiding separator with name "',LItem.Name,'"']); + end; + end; + end; +end; + procedure TMenuItem.CheckChildrenHandles; function GetMenu(Item: TMenuItem): TMenu; @@ -370,6 +434,14 @@ begin if FItems = nil then Exit; + InitiateActions; // actions may update items visibility + if InternalRethinkLines(False) then + begin + // Especially to re-index the items in native way + for i := 0 to Count - 1 do + Items[I].DestroyHandle; + end; + AMenu := GetMenu(Self); AMergedItems := MergedItems; for i := 0 to AMergedItems.InvisibleCount-1 do @@ -691,6 +763,15 @@ begin RecreateHandle; end; +procedure TMenuItem.SetAutoLineReduction(AValue: TMenuItemAutoFlag); +begin + if FAutoLineReduction <> AValue then + begin + FAutoLineReduction := AValue; + MenuChanged(True); + end; +end; + {------------------------------------------------------------------------------ Function: TMenuItem.GetParentMenu Params: none @@ -1053,6 +1134,13 @@ begin end; end; +function TMenuItem.RethinkLines: Boolean; +begin + Result := InternalRethinkLines(True); + if Result then + MenuChanged(True); +end; + procedure TMenuItem.RemoveAllHandlersOfObject(AnObject: TObject); var HandlerType: TMenuItemHandlerType; @@ -1673,4 +1761,20 @@ begin UpdateImage; end; +function TMenuItem.GetAutoLineReduction: Boolean; +var + AutoFlag: TMenuItemAutoFlag; +begin + AutoFlag := FAutoLineReduction; + if (AutoFlag = maParent) and Assigned(Parent) then + if Parent.GetAutoLineReduction then + AutoFlag := maAutomatic + else + AutoFlag := maManual; + case AutoFlag of + maParent, maAutomatic: Result := True; + maManual: Result := False; + end; +end; + // included by menus.pp diff --git a/lcl/menus.pp b/lcl/menus.pp index 3c868fb2ca..395c51b5b0 100644 --- a/lcl/menus.pp +++ b/lcl/menus.pp @@ -59,6 +59,8 @@ type TMenuChangeEvent = procedure (Sender: TObject; Source: TMenuItem; Rebuild: Boolean) of object; + TMenuItemAutoFlag = (maAutomatic, maManual, maParent); + TMenuAutoFlag = maAutomatic..maManual; { TMenuActionLink } @@ -147,6 +149,7 @@ type TMenuItem = class(TLCLComponent) private FActionLink: TMenuActionLink; + FAutoLineReduction: TMenuItemAutoFlag; FCaption: TTranslateString; FBitmap: TBitmap; FGlyphShowMode: TGlyphShowMode; @@ -200,6 +203,7 @@ type function IsVisibleStored: boolean; procedure MergeWith(const aMenu: TMenuItem); procedure SetAutoCheck(const AValue: boolean); + procedure SetAutoLineReduction(AValue: TMenuItemAutoFlag); procedure SetCaption(const AValue: TTranslateString); procedure SetChecked(AValue: Boolean); procedure SetDefault(AValue: Boolean); @@ -222,9 +226,11 @@ type class procedure WSRegisterClass; override; procedure ActionChange(Sender: TObject; CheckDefaults: Boolean); virtual; procedure AssignTo(Dest: TPersistent); override; + function GetAutoLineReduction: Boolean; procedure BitmapChange(Sender: TObject); function DoDrawItem(ACanvas: TCanvas; ARect: TRect; AState: TOwnerDrawState): Boolean; virtual; function DoMeasureItem(ACanvas: TCanvas; var AWidth, AHeight: Integer): Boolean; virtual; + function InternalRethinkLines(AForced: Boolean): Boolean; virtual; function GetAction: TBasicAction; function GetActionLinkClass: TMenuActionLinkClass; virtual; function GetHandle: HMenu; @@ -287,6 +293,7 @@ type procedure Clear; function HasBitmap: boolean; function GetIconSize(ADC: HDC; DPI: Integer = 0): TPoint; virtual; + function RethinkLines: Boolean; // Event lists procedure RemoveAllHandlersOfObject(AnObject: TObject); override; procedure AddHandlerOnDestroy(const OnDestroyEvent: TNotifyEvent; @@ -313,6 +320,8 @@ type published property Action: TBasicAction read GetAction write SetAction; property AutoCheck: boolean read FAutoCheck write SetAutoCheck default False; + property AutoLineReduction: TMenuItemAutoFlag + read FAutoLineReduction write SetAutoLineReduction default maParent; property Caption: TTranslateString read FCaption write SetCaption stored IsCaptionStored; property Checked: Boolean read FChecked write SetChecked @@ -367,8 +376,10 @@ type //See TCustomForm.CMBiDiModeChanged procedure CMParentBiDiModeChanged(var Message: TLMessage); message CM_PARENTBIDIMODECHANGED; procedure CMAppShowMenuGlyphChanged(var Message: TLMessage); message CM_APPSHOWMENUGLYPHCHANGED; + function GetAutoLineReduction: TMenuAutoFlag; function IsBiDiModeStored: Boolean; procedure ImageListChange(Sender: TObject); + procedure SetAutoLineReduction(AValue: TMenuAutoFlag); procedure SetBiDiMode(const AValue: TBiDiMode); procedure SetImages(const AValue: TCustomImageList); procedure SetImagesWidth(const aImagesWidth: Integer); @@ -411,6 +422,8 @@ type property Parent: TComponent read FParent write SetParent; property ShortcutHandled: boolean read FShortcutHandled write FShortcutHandled; published + property AutoLineReduction: TMenuAutoFlag + read GetAutoLineReduction write SetAutoLineReduction default maAutomatic; property BidiMode:TBidiMode read FBidiMode write SetBidiMode stored IsBiDiModeStored default bdLeftToRight; property ParentBidiMode:Boolean read FParentBidiMode write SetParentBidiMode default True; property Items: TMenuItem read FItems;