diff --git a/lcl/actnlist.pas b/lcl/actnlist.pas index 34bcc227f4..100a5e5096 100644 --- a/lcl/actnlist.pas +++ b/lcl/actnlist.pas @@ -223,12 +223,12 @@ type property HelpType; property Hint; property ImageIndex; - property ShortCut; - property SecondaryShortCuts; - property Visible; property OnExecute; property OnHint; property OnUpdate; + property SecondaryShortCuts; + property ShortCut; + property Visible; end; diff --git a/lcl/controls.pp b/lcl/controls.pp index 1537ac9ef9..f0a16cc274 100644 --- a/lcl/controls.pp +++ b/lcl/controls.pp @@ -678,8 +678,15 @@ type function GetUndockHeight: Integer; function GetUndockWidth: Integer; function IsCaptionStored : Boolean; - function IsHelpContextStored: boolean; + function IsColorStored: Boolean; + function IsEnabledStored: Boolean; + function IsFontStored: Boolean; + function IsHintStored: Boolean; + function IsHelpContextStored: Boolean; function IsHelpKeyWordStored: boolean; + function IsOnClickStored: Boolean; + function IsShowHintStored: Boolean; + function IsVisibleStored: Boolean; procedure CheckMenuPopup(const P : TSmallPoint); procedure DoBeforeMouseMessage; procedure DoConstrainedResize(var NewWidth, NewHeight : integer); @@ -757,6 +764,7 @@ type procedure DoOnChangeBounds; virtual; procedure Resize; virtual; procedure Loaded; override; + procedure AssignTo(Dest: TPersistent); override; procedure RequestAlign; dynamic; procedure UpdateBaseBounds(StoreBounds, StoreParentClientSize, UseLoadedValues: boolean); virtual; @@ -914,12 +922,12 @@ type property ControlStyle: TControlStyle read FControlStyle write FControlStyle; property Color: TColor read FColor write SetColor stored ColorIsStored default clWindow; property Ctl3D: Boolean read FCtl3D write FCtl3D;//Is this needed for anything other than compatability? - property Enabled: Boolean read GetEnabled write SetEnabled default True; - property Font: TFont read FFont write SetFont; + property Enabled: Boolean read GetEnabled write SetEnabled stored IsEnabledStored default True; + property Font: TFont read FFont write SetFont stored IsFontStored; property Parent: TWinControl read FParent write SetParent; property PopupMenu: TPopupmenu read GetPopupmenu write SetPopupMenu; - property ShowHint: Boolean read FShowHint write SetShowHint default False; - property Visible: Boolean read FVisible write SetVisible default True; + property ShowHint: Boolean read FShowHint write SetShowHint stored IsShowHintStored default False; + property Visible: Boolean read FVisible write SetVisible stored IsVisibleStored default True; property WindowProc: TWndMethod read FWindowProc write FWindowProc; property TabStop: Boolean read FTabStop write SetTabStop; property TabOrder: TTabOrder read GetTabOrder write SetTaborder default -1; @@ -936,7 +944,7 @@ type public property OnResize: TNotifyEvent read FOnResize write FOnResize; property OnChangeBounds: TNotifyEvent read FOnChangeBounds write FOnChangeBounds; - property OnClick: TNotifyEvent read FOnClick write FOnClick; + property OnClick: TNotifyEvent read FOnClick write FOnClick stored IsOnClickStored; property OnShowHint: TControlShowHintEvent read FOnShowHint write FOnShowHint; published property Cursor: TCursor read FCursor write SetCursor default crDefault; @@ -1046,6 +1054,7 @@ type procedure SetUseDockManager(const AValue: Boolean); procedure UpdateTabOrder(NewTabValue: TTabOrder); protected + procedure AssignTo(Dest: TPersistent); override; procedure ActionChange(Sender: TObject; CheckDefaults: Boolean); override; function GetActionLinkClass: TControlActionLinkClass; override; procedure AdjustSize; override; @@ -1893,6 +1902,9 @@ end. { ============================================================================= $Log$ + Revision 1.173 2004/02/04 23:30:18 mattias + completed TControl actions + Revision 1.172 2004/02/02 16:59:28 mattias more Actions TAction, TBasicAction, ... diff --git a/lcl/include/control.inc b/lcl/include/control.inc index 3235ae833c..e725a6c8e5 100644 --- a/lcl/include/control.inc +++ b/lcl/include/control.inc @@ -473,6 +473,21 @@ begin Result := not ActionLink.IsHelpContextLinked; end; +function TControl.IsOnClickStored: Boolean; +begin + Result := (ActionLink = nil) or not ActionLink.IsOnExecuteLinked; +end; + +function TControl.IsShowHintStored: Boolean; +begin + Result := not ParentShowHint; +end; + +function TControl.IsVisibleStored: Boolean; +begin + Result := (ActionLink = nil) or not ActionLink.IsVisibleLinked; +end; + {------------------------------------------------------------------------------} { TControl GetTabOrder } {------------------------------------------------------------------------------} @@ -1585,7 +1600,12 @@ end; {------------------------------------------------------------------------------} Procedure TControl.Click; Begin - if Assigned (FOnClick) then FOnClick(Self); + if (not (csDesigning in ComponentState)) and (ActionLink<>nil) + and ((Action=nil) or (@FOnClick<>@Action.OnExecute) or Assigned(FOnClick)) + then + ActionLink.Execute(Self) + else if Assigned(FOnClick) then + FOnClick(Self); end; {------------------------------------------------------------------------------} @@ -1765,7 +1785,8 @@ procedure TControl.Notification( AComponent : TComponent; Operation : TOperation begin inherited Notification(AComponent, Operation); if Operation = opRemove then - if AComponent = PopupMenu then PopupMenu := nil; + if AComponent = PopupMenu then PopupMenu := nil + else if AComponent = Action then Action := nil; end; {------------------------------------------------------------------------------ @@ -1803,7 +1824,27 @@ end; ------------------------------------------------------------------------------} Function TControl.IsCaptionStored : Boolean; Begin - Result := true; + Result := (ActionLink = nil) or not ActionLink.IsCaptionLinked; +end; + +function TControl.IsColorStored: Boolean; +begin + Result := not ParentColor; +end; + +function TControl.IsEnabledStored: Boolean; +begin + Result := (ActionLink = nil) or not ActionLink.IsEnabledLinked; +end; + +function TControl.IsFontStored: Boolean; +begin + Result := not ParentFont {and not DesktopFont}; +end; + +function TControl.IsHintStored: Boolean; +begin + Result := (ActionLink = nil) or not ActionLink.IsHintLinked; end; {------------------------------------------------------------------------------ @@ -1943,6 +1984,20 @@ begin // align this control and the brothers if cfRequestAlignNeeded in FControlFlags then RequestAlign; + if Action <> nil then ActionChange(Action, True); +end; + +procedure TControl.AssignTo(Dest: TPersistent); +begin + if Dest is TCustomAction then + with TCustomAction(Dest) do begin + Enabled := Self.Enabled; + Hint := Self.Hint; + Caption := Self.Caption; + Visible := Self.Visible; + OnExecute := Self.OnClick; + end + else inherited AssignTo(Dest); end; {------------------------------------------------------------------------------} @@ -2486,6 +2541,7 @@ begin //writeln('[TControl.Destroy] A ',Name,':',ClassName); Application.ControlDestroyed(Self); SetParent(nil); + FreeThenNil(FActionLink); FreeThenNil(FConstraints); FreeThenNil(FFont); //writeln('[TControl.Destroy] B ',Name,':',ClassName); @@ -2679,6 +2735,9 @@ end; { ============================================================================= $Log$ + Revision 1.167 2004/02/04 23:30:18 mattias + completed TControl actions + Revision 1.166 2004/02/02 16:59:28 mattias more Actions TAction, TBasicAction, ... diff --git a/lcl/include/wincontrol.inc b/lcl/include/wincontrol.inc index da26ad2fd8..8e02c409bb 100644 --- a/lcl/include/wincontrol.inc +++ b/lcl/include/wincontrol.inc @@ -1875,6 +1875,13 @@ begin end; end; +procedure TWinControl.AssignTo(Dest: TPersistent); +begin + inherited AssignTo(Dest); + if Dest is TCustomAction then + TCustomAction(Dest).HelpContext:=HelpContext; +end; + procedure TWinControl.ActionChange(Sender: TObject; CheckDefaults: Boolean); begin inherited ActionChange(Sender,CheckDefaults); @@ -3285,6 +3292,9 @@ end; { ============================================================================= $Log$ + Revision 1.198 2004/02/04 23:30:18 mattias + completed TControl actions + Revision 1.197 2004/02/04 17:39:30 mattias quick fixed TToolBar destruction diff --git a/lcl/stdctrls.pp b/lcl/stdctrls.pp index 5b2f242820..d713400b48 100644 --- a/lcl/stdctrls.pp +++ b/lcl/stdctrls.pp @@ -323,6 +323,7 @@ type property OnMouseDown; property OnMouseMove; property OnMouseUp; + property OnSelect; property ParentCtl3D; property ParentFont; property ParentShowHint; @@ -1488,6 +1489,9 @@ end. { ============================================================================= $Log$ + Revision 1.126 2004/02/04 23:30:18 mattias + completed TControl actions + Revision 1.125 2004/02/04 22:17:09 mattias removed workaround VirtualCreate diff --git a/lcl/toolwin.pp b/lcl/toolwin.pp index 9e15b2fedd..7465b54f67 100644 --- a/lcl/toolwin.pp +++ b/lcl/toolwin.pp @@ -49,12 +49,6 @@ uses type { TToolWindow } - { - @abstract(Short description of the class.) - Introduced by Author Name - Currently maintained by Maintainer Name - } -{ TToolWindow } TEdgeBorder = (ebLeft, ebTop, ebRight, ebBottom); TEdgeBorders = set of TEdgeBorder;