paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-08-09 20:15:58 +02:00
Code Issues Packages Projects Releases Wiki Activity

added TMenuItem.Action

Browse Source 
git-svn-id: trunk@5142 -
This commit is contained in:
mattias 2004-02-02 18:09:41 +00:00
parent 31dd1da1b8
commit f5c3e32e19
3 changed files with 109 additions and 17 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

16
lcl/include/menuactionlink.inc
View File

@ -23,9 +23,7 @@ end;
function TMenuActionLink.IsAutoCheckLinked: Boolean;
begin
Result:=false;
// ToDo:
//Result := FClient.AutoCheck = (Action as TCustomAction).AutoCheck;
Result := FClient.AutoCheck = (Action as TCustomAction).AutoCheck;
end;
function TMenuActionLink.IsCaptionLinked: Boolean;
@ -48,10 +46,8 @@ end;
function TMenuActionLink.IsHelpContextLinked: Boolean;
begin
Result:=false;
// ToDo:
//Result := inherited IsHelpContextLinked and
// (FClient.HelpContext = (Action as TCustomAction).HelpContext);
Result := inherited IsHelpContextLinked
and (FClient.HelpContext = (Action as TCustomAction).HelpContext);
end;
function TMenuActionLink.IsHintLinked: Boolean;
@ -92,8 +88,7 @@ end;
procedure TMenuActionLink.SetAutoCheck(Value: Boolean);
begin
// ToDo:
//if IsAutoCheckLinked then FClient.AutoCheck := Value;
if IsAutoCheckLinked then FClient.AutoCheck := Value;
end;
procedure TMenuActionLink.SetCaption(const Value: string);
@ -113,8 +108,7 @@ end;
procedure TMenuActionLink.SetHelpContext(Value: THelpContext);
begin
// ToDo:
//if IsHelpContextLinked then FClient.HelpContext := Value;
if IsHelpContextLinked then FClient.HelpContext := Value;
end;
procedure TMenuActionLink.SetHint(const Value: string);

88
lcl/include/menuitem.inc
View File

@ -248,6 +248,73 @@ Begin
Proc(TComponent (FItems [i]));
end;
function TMenuItem.GetAction: TBasicAction;
begin
if FActionLink <> nil then
Result := FActionLink.Action
else
Result := nil;
end;
procedure TMenuItem.SetAction(Value: TBasicAction);
begin
if Value = nil then begin
FActionLink.Free;
FActionLink := nil;
end else begin
if FActionLink = nil then
FActionLink := GetActionLinkClass.Create(Self);
FActionLink.Action := Value;
FActionLink.OnChange := @DoActionChange;
ActionChange(Value, csLoading in Value.ComponentState);
Value.FreeNotification(Self);
end;
end;
procedure TMenuItem.InitiateActions;
var
i: Integer;
begin
for i := 0 to Count - 1 do
Items[i].InitiateAction;
end;
procedure TMenuItem.ActionChange(Sender: TObject; CheckDefaults: Boolean);
begin
if Sender is TCustomAction then begin
with TCustomAction(Sender) do
begin
if not CheckDefaults or (Self.AutoCheck = False) then
Self.AutoCheck := AutoCheck;
if not CheckDefaults or (Self.Caption = '') then
Self.Caption := Caption;
if not CheckDefaults or (Self.Checked = False) then
Self.Checked := Checked;
if not CheckDefaults or (Self.Enabled = True) then
Self.Enabled := Enabled;
if not CheckDefaults or (Self.HelpContext = 0) then
Self.HelpContext := HelpContext;
if not CheckDefaults or (Self.Hint = '') then
Self.Hint := Hint;
if RadioItem and (not CheckDefaults or (Self.GroupIndex = 0)) then
Self.GroupIndex := GroupIndex;
if not CheckDefaults or (Self.ImageIndex = -1) then
Self.ImageIndex := ImageIndex;
if not CheckDefaults or (Self.ShortCut = scNone) then
Self.ShortCut := ShortCut;
if not CheckDefaults or (Self.Visible = True) then
Self.Visible := Visible;
if not CheckDefaults or not Assigned(Self.OnClick) then
Self.OnClick := OnExecute;
end;
end;
end;
function TMenuItem.GetActionLinkClass: TMenuActionLinkClass;
begin
Result := TMenuActionLink;
end;
{------------------------------------------------------------------------------
Function: TMenuItem.GetCount
Params: none
@ -343,6 +410,11 @@ begin
Result := (ActionLink = nil) or not FActionLink.IsEnabledLinked;
end;
function TMenuItem.IsHelpContextStored: boolean;
begin
Result := (ActionLink = nil) or not FActionLink.IsHelpContextLinked;
end;
{------------------------------------------------------------------------------
function TMenuItem.IsShortCutStored: boolean;
@ -473,6 +545,11 @@ begin
Result := assigned (FParent);
end;
procedure TMenuItem.InitiateAction;
begin
if FActionLink <> nil then FActionLink.Update;
end;
{------------------------------------------------------------------------------
Method: TMenuItem.Insert
Params: Index: Location of the menuitem to insert
@ -961,6 +1038,11 @@ begin
end;
end;
procedure TMenuItem.DoActionChange(Sender: TObject);
begin
if Sender=Action then ActionChange(Sender,False);
end;
{------------------------------------------------------------------------------
Method: TMenuItem.VerifyGroupIndex
@ -997,6 +1079,9 @@ end;
{ =============================================================================
$Log$
Revision 1.46 2004/02/02 18:09:41 mattias
added TMenuItem.Action
Revision 1.45 2004/01/11 16:38:29 marc
* renamed (Check|Enable)MenuItem to MenuItemSet(Check|Enable)
+ Started with accelerator nameing routines
@ -1163,6 +1248,9 @@ end;
$Log$
Revision 1.46 2004/02/02 18:09:41 mattias
added TMenuItem.Action
Revision 1.45 2004/01/11 16:38:29 marc
* renamed (Check|Enable)MenuItem to MenuItemSet(Check|Enable)
+ Started with accelerator nameing routines

22
lcl/menus.pp
View File

@ -104,6 +104,7 @@ type
FBitmap: TBitmap;
FGroupIndex: Byte;
FHandle: HMenu;
FHelpContext: THelpContext;
FHint: String;
FImageIndex : Integer;
FItems: TList; // list of TMenuItem
@ -124,6 +125,7 @@ type
function IsCaptionStored: boolean;
function IsCheckedStored: boolean;
function IsEnabledStored: boolean;
function IsHelpContextStored: boolean;
function IsShortCutStored: boolean;
function IsVisibleStored: boolean;
procedure SetAutoCheck(const AValue: boolean);
@ -141,13 +143,8 @@ type
procedure SubItemChanged(Sender: TObject; Source: TMenuItem;
Rebuild: Boolean);
procedure TurnSiblingsOff;
(*
* MWE: Disabled this feature, it makes not much sense
* See comments below
procedure VerifyGroupIndex(Position: Integer; Value: Byte);
*)
procedure DoActionChange(Sender: TObject);
protected
property ActionLink: TMenuActionLink read FActionLink write FActionLink;
procedure CreateHandle; virtual;
procedure DestroyHandle; virtual;
procedure DoClicked(var msg); message LM_ACTIVATE;
@ -160,6 +157,13 @@ type
procedure SetChildOrder(Child: TComponent; Order: Integer); override;
procedure SetParentComponent(AValue : TComponent); override;
procedure GetChildren(Proc: TGetChildProc; Root: TComponent); override;
function GetAction: TBasicAction;
procedure SetAction(Value: TBasicAction);
procedure InitiateActions;
procedure ActionChange(Sender: TObject; CheckDefaults: Boolean); dynamic;
function GetActionLinkClass: TMenuActionLinkClass; dynamic;
protected
property ActionLink: TMenuActionLink read FActionLink write FActionLink;
public
FCompStyle : LongInt;
constructor Create(TheOwner: TComponent); override;
@ -170,6 +174,7 @@ type
function HandleAllocated : Boolean;
function HasIcon: boolean; virtual;
function HasParent : Boolean; override;
procedure InitiateAction; virtual;
function IndexOf(Item: TMenuItem): Integer;
function IndexOfCaption(const ACaption: string): Integer; virtual;
function IsCheckItem: boolean; virtual;
@ -191,6 +196,7 @@ type
property Parent: TMenuItem read GetParent;
property Command: integer read FCommand;
published
property Action: TBasicAction read GetAction write SetAction;
property AutoCheck: boolean read FAutoCheck write SetAutoCheck default False;
property Caption: String read FCaption write SetCaption
stored IsCaptionStored;
@ -201,6 +207,7 @@ type
stored IsEnabledStored default True;
property Bitmap: TBitmap read FBitmap write SetBitmap;
property GroupIndex: Byte read FGroupIndex write SetGroupIndex default 0;
property HelpContext: THelpContext read FHelpContext write FHelpContext stored IsHelpContextStored default 0;
property Hint: String read FHint write FHint;
property ImageIndex: Integer read FImageIndex write SetImageIndex;
property RadioItem: Boolean read FRadioItem write SetRadioItem
@ -386,6 +393,9 @@ end.
{
$Log$
Revision 1.59 2004/02/02 18:09:41 mattias
added TMenuItem.Action
Revision 1.58 2004/01/10 18:09:38 mattias
implemented TMenuItem.Clear