mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-04-09 04:07:57 +02:00
LCL: first try at implementing TMenuItem.AutoLineReduction. Based upon patch by Artem Izmaylov, modified by me.
This commit is contained in:
parent
e1d376486e
commit
e762d9b696
@ -22,6 +22,7 @@
|
|||||||
constructor TMenu.Create(AOwner: TComponent);
|
constructor TMenu.Create(AOwner: TComponent);
|
||||||
begin
|
begin
|
||||||
FItems := TMenuItem.Create(Self);
|
FItems := TMenuItem.Create(Self);
|
||||||
|
FItems.FAutoLineReduction := maAutomatic;
|
||||||
FItems.FOnChange := @MenuChanged;
|
FItems.FOnChange := @MenuChanged;
|
||||||
FItems.FMenu := Self;
|
FItems.FMenu := Self;
|
||||||
FImageChangeLink := TChangeLink.Create;
|
FImageChangeLink := TChangeLink.Create;
|
||||||
@ -93,6 +94,14 @@ begin
|
|||||||
FItems.UpdateImages;
|
FItems.UpdateImages;
|
||||||
end;
|
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;
|
procedure TMenu.BidiModeChanged;
|
||||||
begin
|
begin
|
||||||
if HandleAllocated then
|
if HandleAllocated then
|
||||||
@ -140,6 +149,11 @@ begin
|
|||||||
if Sender = Images then UpdateItems;
|
if Sender = Images then UpdateItems;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
procedure TMenu.SetAutoLineReduction(AValue: TMenuAutoFlag);
|
||||||
|
begin
|
||||||
|
FItems.AutoLineReduction := AValue;
|
||||||
|
end;
|
||||||
|
|
||||||
{------------------------------------------------------------------------------
|
{------------------------------------------------------------------------------
|
||||||
Method: TMenu.CreateHandle
|
Method: TMenu.CreateHandle
|
||||||
Params: None
|
Params: None
|
||||||
|
@ -115,6 +115,7 @@ begin
|
|||||||
FRightJustify := False;
|
FRightJustify := False;
|
||||||
FShowAlwaysCheckable := False;
|
FShowAlwaysCheckable := False;
|
||||||
FGlyphShowMode := gsmApplication;
|
FGlyphShowMode := gsmApplication;
|
||||||
|
FAutoLineReduction := maParent;
|
||||||
|
|
||||||
FImageChangeLink := TChangeLink.Create;
|
FImageChangeLink := TChangeLink.Create;
|
||||||
FImageChangeLink.OnChange := @ImageListChange;
|
FImageChangeLink.OnChange := @ImageListChange;
|
||||||
@ -342,6 +343,69 @@ begin
|
|||||||
end;
|
end;
|
||||||
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;
|
procedure TMenuItem.CheckChildrenHandles;
|
||||||
|
|
||||||
function GetMenu(Item: TMenuItem): TMenu;
|
function GetMenu(Item: TMenuItem): TMenu;
|
||||||
@ -370,6 +434,14 @@ begin
|
|||||||
if FItems = nil then
|
if FItems = nil then
|
||||||
Exit;
|
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);
|
AMenu := GetMenu(Self);
|
||||||
AMergedItems := MergedItems;
|
AMergedItems := MergedItems;
|
||||||
for i := 0 to AMergedItems.InvisibleCount-1 do
|
for i := 0 to AMergedItems.InvisibleCount-1 do
|
||||||
@ -691,6 +763,15 @@ begin
|
|||||||
RecreateHandle;
|
RecreateHandle;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
procedure TMenuItem.SetAutoLineReduction(AValue: TMenuItemAutoFlag);
|
||||||
|
begin
|
||||||
|
if FAutoLineReduction <> AValue then
|
||||||
|
begin
|
||||||
|
FAutoLineReduction := AValue;
|
||||||
|
MenuChanged(True);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
{------------------------------------------------------------------------------
|
{------------------------------------------------------------------------------
|
||||||
Function: TMenuItem.GetParentMenu
|
Function: TMenuItem.GetParentMenu
|
||||||
Params: none
|
Params: none
|
||||||
@ -1053,6 +1134,13 @@ begin
|
|||||||
end;
|
end;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
function TMenuItem.RethinkLines: Boolean;
|
||||||
|
begin
|
||||||
|
Result := InternalRethinkLines(True);
|
||||||
|
if Result then
|
||||||
|
MenuChanged(True);
|
||||||
|
end;
|
||||||
|
|
||||||
procedure TMenuItem.RemoveAllHandlersOfObject(AnObject: TObject);
|
procedure TMenuItem.RemoveAllHandlersOfObject(AnObject: TObject);
|
||||||
var
|
var
|
||||||
HandlerType: TMenuItemHandlerType;
|
HandlerType: TMenuItemHandlerType;
|
||||||
@ -1673,4 +1761,20 @@ begin
|
|||||||
UpdateImage;
|
UpdateImage;
|
||||||
end;
|
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
|
// included by menus.pp
|
||||||
|
13
lcl/menus.pp
13
lcl/menus.pp
@ -59,6 +59,8 @@ type
|
|||||||
|
|
||||||
TMenuChangeEvent = procedure (Sender: TObject; Source: TMenuItem;
|
TMenuChangeEvent = procedure (Sender: TObject; Source: TMenuItem;
|
||||||
Rebuild: Boolean) of object;
|
Rebuild: Boolean) of object;
|
||||||
|
TMenuItemAutoFlag = (maAutomatic, maManual, maParent);
|
||||||
|
TMenuAutoFlag = maAutomatic..maManual;
|
||||||
|
|
||||||
{ TMenuActionLink }
|
{ TMenuActionLink }
|
||||||
|
|
||||||
@ -147,6 +149,7 @@ type
|
|||||||
TMenuItem = class(TLCLComponent)
|
TMenuItem = class(TLCLComponent)
|
||||||
private
|
private
|
||||||
FActionLink: TMenuActionLink;
|
FActionLink: TMenuActionLink;
|
||||||
|
FAutoLineReduction: TMenuItemAutoFlag;
|
||||||
FCaption: TTranslateString;
|
FCaption: TTranslateString;
|
||||||
FBitmap: TBitmap;
|
FBitmap: TBitmap;
|
||||||
FGlyphShowMode: TGlyphShowMode;
|
FGlyphShowMode: TGlyphShowMode;
|
||||||
@ -200,6 +203,7 @@ type
|
|||||||
function IsVisibleStored: boolean;
|
function IsVisibleStored: boolean;
|
||||||
procedure MergeWith(const aMenu: TMenuItem);
|
procedure MergeWith(const aMenu: TMenuItem);
|
||||||
procedure SetAutoCheck(const AValue: boolean);
|
procedure SetAutoCheck(const AValue: boolean);
|
||||||
|
procedure SetAutoLineReduction(AValue: TMenuItemAutoFlag);
|
||||||
procedure SetCaption(const AValue: TTranslateString);
|
procedure SetCaption(const AValue: TTranslateString);
|
||||||
procedure SetChecked(AValue: Boolean);
|
procedure SetChecked(AValue: Boolean);
|
||||||
procedure SetDefault(AValue: Boolean);
|
procedure SetDefault(AValue: Boolean);
|
||||||
@ -222,9 +226,11 @@ type
|
|||||||
class procedure WSRegisterClass; override;
|
class procedure WSRegisterClass; override;
|
||||||
procedure ActionChange(Sender: TObject; CheckDefaults: Boolean); virtual;
|
procedure ActionChange(Sender: TObject; CheckDefaults: Boolean); virtual;
|
||||||
procedure AssignTo(Dest: TPersistent); override;
|
procedure AssignTo(Dest: TPersistent); override;
|
||||||
|
function GetAutoLineReduction: Boolean;
|
||||||
procedure BitmapChange(Sender: TObject);
|
procedure BitmapChange(Sender: TObject);
|
||||||
function DoDrawItem(ACanvas: TCanvas; ARect: TRect; AState: TOwnerDrawState): Boolean; virtual;
|
function DoDrawItem(ACanvas: TCanvas; ARect: TRect; AState: TOwnerDrawState): Boolean; virtual;
|
||||||
function DoMeasureItem(ACanvas: TCanvas; var AWidth, AHeight: Integer): Boolean; virtual;
|
function DoMeasureItem(ACanvas: TCanvas; var AWidth, AHeight: Integer): Boolean; virtual;
|
||||||
|
function InternalRethinkLines(AForced: Boolean): Boolean; virtual;
|
||||||
function GetAction: TBasicAction;
|
function GetAction: TBasicAction;
|
||||||
function GetActionLinkClass: TMenuActionLinkClass; virtual;
|
function GetActionLinkClass: TMenuActionLinkClass; virtual;
|
||||||
function GetHandle: HMenu;
|
function GetHandle: HMenu;
|
||||||
@ -287,6 +293,7 @@ type
|
|||||||
procedure Clear;
|
procedure Clear;
|
||||||
function HasBitmap: boolean;
|
function HasBitmap: boolean;
|
||||||
function GetIconSize(ADC: HDC; DPI: Integer = 0): TPoint; virtual;
|
function GetIconSize(ADC: HDC; DPI: Integer = 0): TPoint; virtual;
|
||||||
|
function RethinkLines: Boolean;
|
||||||
// Event lists
|
// Event lists
|
||||||
procedure RemoveAllHandlersOfObject(AnObject: TObject); override;
|
procedure RemoveAllHandlersOfObject(AnObject: TObject); override;
|
||||||
procedure AddHandlerOnDestroy(const OnDestroyEvent: TNotifyEvent;
|
procedure AddHandlerOnDestroy(const OnDestroyEvent: TNotifyEvent;
|
||||||
@ -313,6 +320,8 @@ type
|
|||||||
published
|
published
|
||||||
property Action: TBasicAction read GetAction write SetAction;
|
property Action: TBasicAction read GetAction write SetAction;
|
||||||
property AutoCheck: boolean read FAutoCheck write SetAutoCheck default False;
|
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
|
property Caption: TTranslateString read FCaption write SetCaption
|
||||||
stored IsCaptionStored;
|
stored IsCaptionStored;
|
||||||
property Checked: Boolean read FChecked write SetChecked
|
property Checked: Boolean read FChecked write SetChecked
|
||||||
@ -367,8 +376,10 @@ type
|
|||||||
//See TCustomForm.CMBiDiModeChanged
|
//See TCustomForm.CMBiDiModeChanged
|
||||||
procedure CMParentBiDiModeChanged(var Message: TLMessage); message CM_PARENTBIDIMODECHANGED;
|
procedure CMParentBiDiModeChanged(var Message: TLMessage); message CM_PARENTBIDIMODECHANGED;
|
||||||
procedure CMAppShowMenuGlyphChanged(var Message: TLMessage); message CM_APPSHOWMENUGLYPHCHANGED;
|
procedure CMAppShowMenuGlyphChanged(var Message: TLMessage); message CM_APPSHOWMENUGLYPHCHANGED;
|
||||||
|
function GetAutoLineReduction: TMenuAutoFlag;
|
||||||
function IsBiDiModeStored: Boolean;
|
function IsBiDiModeStored: Boolean;
|
||||||
procedure ImageListChange(Sender: TObject);
|
procedure ImageListChange(Sender: TObject);
|
||||||
|
procedure SetAutoLineReduction(AValue: TMenuAutoFlag);
|
||||||
procedure SetBiDiMode(const AValue: TBiDiMode);
|
procedure SetBiDiMode(const AValue: TBiDiMode);
|
||||||
procedure SetImages(const AValue: TCustomImageList);
|
procedure SetImages(const AValue: TCustomImageList);
|
||||||
procedure SetImagesWidth(const aImagesWidth: Integer);
|
procedure SetImagesWidth(const aImagesWidth: Integer);
|
||||||
@ -411,6 +422,8 @@ type
|
|||||||
property Parent: TComponent read FParent write SetParent;
|
property Parent: TComponent read FParent write SetParent;
|
||||||
property ShortcutHandled: boolean read FShortcutHandled write FShortcutHandled;
|
property ShortcutHandled: boolean read FShortcutHandled write FShortcutHandled;
|
||||||
published
|
published
|
||||||
|
property AutoLineReduction: TMenuAutoFlag
|
||||||
|
read GetAutoLineReduction write SetAutoLineReduction default maAutomatic;
|
||||||
property BidiMode:TBidiMode read FBidiMode write SetBidiMode stored IsBiDiModeStored default bdLeftToRight;
|
property BidiMode:TBidiMode read FBidiMode write SetBidiMode stored IsBiDiModeStored default bdLeftToRight;
|
||||||
property ParentBidiMode:Boolean read FParentBidiMode write SetParentBidiMode default True;
|
property ParentBidiMode:Boolean read FParentBidiMode write SetParentBidiMode default True;
|
||||||
property Items: TMenuItem read FItems;
|
property Items: TMenuItem read FItems;
|
||||||
|
Loading…
Reference in New Issue
Block a user