paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-04-14 03:19:32 +02:00
Code Issues Packages Projects Releases Wiki Activity

completed TControl actions

Browse Source 
git-svn-id: trunk@5171 -
This commit is contained in:
mattias 2004-02-04 23:30:18 +00:00
parent 62df951988
commit ddd3ba7dbd
6 changed files with 97 additions and 18 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
lcl/actnlist.pas
View File

@ -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;

24
lcl/controls.pp
View File

@ -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, ...

65
lcl/include/control.inc
View File

@ -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, ...

10
lcl/include/wincontrol.inc
View File

@ -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

4
lcl/stdctrls.pp
View File

@ -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

6
lcl/toolwin.pp
View File

@ -49,12 +49,6 @@ uses
type
{ TToolWindow }
{
@abstract(Short description of the class.)
Introduced by Author Name <author@emailaddress.com>
Currently maintained by Maintainer Name <mainter@emailaddress.com>
}
{ TToolWindow }
TEdgeBorder = (ebLeft, ebTop, ebRight, ebBottom);
TEdgeBorders = set of TEdgeBorder;