diff --git a/fcl/inc/action.inc b/fcl/inc/action.inc new file mode 100644 index 0000000000..85b5cdc107 --- /dev/null +++ b/fcl/inc/action.inc @@ -0,0 +1,193 @@ +{ + $Id$ + This file is part of the Free Component Library (FCL) + Copyright (c) 1999-2000 by the Free Pascal development team + + See the file COPYING.FPC, included in this distribution, + for details about the copyright. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. + + **********************************************************************} + +{****************************************************************************} +{* TBasicActionLink *} +{****************************************************************************} + +constructor TBasicActionLink.Create(AClient: TObject); +begin + inherited Create; + AssignClient(AClient); +end; + + +procedure TBasicActionLink.AssignClient(AClient: TObject); +begin +end; + + +destructor TBasicActionLink.Destroy; +begin + if FAction <> nil then + FAction.UnRegisterChanges(Self); + inherited Destroy; +end; + + +procedure TBasicActionLink.Change; +begin + if Assigned(OnChange) then + OnChange(FAction); +end; + + +function TBasicActionLink.Execute(AComponent: TComponent): Boolean; +begin + FAction.ActionComponent := AComponent; + try + Result := FAction.Execute; + finally + if FAction <> nil then + FAction.ActionComponent := nil; + end; +end; + + +procedure TBasicActionLink.SetAction(Value: TBasicAction); +begin + if Value <> FAction then + begin + if FAction <> nil then FAction.UnRegisterChanges(Self); + FAction := Value; + if Value <> nil then Value.RegisterChanges(Self); + end; +end; + + +function TBasicActionLink.IsOnExecuteLinked: Boolean; +begin + Result := True; +end; + + +procedure TBasicActionLink.SetOnExecute(Value: TNotifyEvent); +begin +end; + + +function TBasicActionLink.Update: Boolean; +begin + Result := FAction.Update; +end; + +{****************************************************************************} +{* TBasicAction *} +{****************************************************************************} + +constructor TBasicAction.Create(AOwner: TComponent); +begin + inherited Create(AOwner); + FClients := TList.Create; +end; + + +destructor TBasicAction.Destroy; +begin + inherited Destroy; + while FClients.Count > 0 do + UnRegisterChanges(TBasicActionLink(FClients.Last)); + FClients.Free; +end; + + +function TBasicAction.HandlesTarget(Target: TObject): Boolean; +begin + Result := False; +end; + + +procedure TBasicAction.ExecuteTarget(Target: TObject); +begin +end; + + +procedure TBasicAction.UpdateTarget(Target: TObject); +begin +end; + + +function TBasicAction.Execute: Boolean; +begin + if Assigned(FOnExecute) then + begin + FOnExecute(Self); + Result := True; + end + else + Result := False; +end; + + +function TBasicAction.Update: Boolean; +begin + if Assigned(FOnUpdate) then + begin + FOnUpdate(Self); + Result := True; + end + else + Result := False; +end; + + +procedure TBasicAction.SetOnExecute(Value: TNotifyEvent); +var + I: Integer; +begin + if (TMethod(Value).Code <> TMethod(OnExecute).Code) or + (TMethod(Value).Data <> TMethod(OnExecute).Data) then + begin + for I := 0 to FClients.Count - 1 do + TBasicActionLink(FClients[I]).SetOnExecute(Value); + FOnExecute := Value; + Change; + end; +end; + + +procedure TBasicAction.Change; +begin + if Assigned(FOnChange) then + FOnChange(Self); +end; + + +procedure TBasicAction.RegisterChanges(Value: TBasicActionLink); +begin + Value.FAction := Self; + FClients.Add(Value); +end; + + +procedure TBasicAction.UnRegisterChanges(Value: TBasicActionLink); +var + I: Integer; +begin + for I := 0 to FClients.Count - 1 do + if TBasicActionLink(FClients[I]) = Value then + begin + Value.FAction := nil; + FClients.Delete(I); + break; + end; +end; + + +{ + $Log$ + Revision 1.1 2002-01-06 21:54:49 peter + * action classes added + +} diff --git a/fcl/inc/classes.inc b/fcl/inc/classes.inc index 7084a8633e..ee39ac74c7 100644 --- a/fcl/inc/classes.inc +++ b/fcl/inc/classes.inc @@ -69,6 +69,9 @@ var { TComponent implementation } {$i compon.inc} +{ TBasicAction implementation } +{$i action.inc} + { Class and component registration routines } {$I cregist.inc} @@ -1182,7 +1185,10 @@ end; { $Log$ - Revision 1.7 2001-04-10 23:24:51 peter + Revision 1.8 2002-01-06 21:54:49 peter + * action classes added + + Revision 1.7 2001/04/10 23:24:51 peter * merged fixes Revision 1.6 2001/03/08 19:39:25 michael diff --git a/fcl/inc/classesh.inc b/fcl/inc/classesh.inc index ca8685c00f..9a86af4158 100644 --- a/fcl/inc/classesh.inc +++ b/fcl/inc/classesh.inc @@ -1139,6 +1139,8 @@ type end; } + TBasicAction = class; + TComponent = class(TPersistent) private FOwner: TComponent; @@ -1205,6 +1207,7 @@ type destructor Destroy; override; procedure DestroyComponents; procedure Destroying; + function ExecuteAction(Action: TBasicAction): Boolean; dynamic; function FindComponent(const AName: string): TComponent; procedure FreeNotification(AComponent: TComponent); procedure RemoveFreeNotification(AComponent: TComponent); @@ -1215,6 +1218,7 @@ type procedure RemoveComponent(AComponent: TComponent); function SafeCallException(ExceptObject: TObject; ExceptAddr: Pointer): Integer; override; + function UpdateAction(Action: TBasicAction): Boolean; dynamic; // property ComObject: IUnknown read GetComObject; property Components[Index: Integer]: TComponent read GetComponent; property ComponentCount: Integer read GetComponentCount; @@ -1229,6 +1233,60 @@ type property Tag: Longint read FTag write FTag default 0; end; +{ TBasicActionLink } + + TBasicActionLink = class(TObject) + private + FOnChange: TNotifyEvent; + protected + FAction: TBasicAction; + procedure AssignClient(AClient: TObject); virtual; + procedure Change; virtual; + function IsOnExecuteLinked: Boolean; virtual; + procedure SetAction(Value: TBasicAction); virtual; + procedure SetOnExecute(Value: TNotifyEvent); virtual; + public + constructor Create(AClient: TObject); virtual; + destructor Destroy; override; + function Execute(AComponent: TComponent{$ifndef VER1_0} = nil{$endif}): Boolean; virtual; + function Update: Boolean; virtual; + property Action: TBasicAction read FAction write SetAction; + property OnChange: TNotifyEvent read FOnChange write FOnChange; + end; + + TBasicActionLinkClass = class of TBasicActionLink; + +{ TBasicAction } + + TBasicAction = class(TComponent) + private + FActionComponent: TComponent; + FOnChange: TNotifyEvent; + FOnExecute: TNotifyEvent; + FOnUpdate: TNotifyEvent; + protected + FClients: TList; + procedure Change; virtual; + procedure SetOnExecute(Value: TNotifyEvent); virtual; + property OnChange: TNotifyEvent read FOnChange write FOnChange; + public + constructor Create(AOwner: TComponent); override; + destructor Destroy; override; + function HandlesTarget(Target: TObject): Boolean; virtual; + procedure UpdateTarget(Target: TObject); virtual; + procedure ExecuteTarget(Target: TObject); virtual; + function Execute: Boolean; dynamic; + procedure RegisterChanges(Value: TBasicActionLink); + procedure UnRegisterChanges(Value: TBasicActionLink); + function Update: Boolean; virtual; + property ActionComponent: TComponent read FActionComponent write FActionComponent; + property OnExecute: TNotifyEvent read FOnExecute write SetOnExecute; + property OnUpdate: TNotifyEvent read FOnUpdate write FOnUpdate; + end; + +{ TBasicAction class reference type } + + TBasicActionClass = class of TBasicAction; { Component registration handlers } @@ -1331,7 +1389,10 @@ function LineStart(Buffer, BufPos: PChar): PChar; { $Log$ - Revision 1.17 2001-12-03 21:39:58 peter + Revision 1.18 2002-01-06 21:54:49 peter + * action classes added + + Revision 1.17 2001/12/03 21:39:58 peter * seek(int64) overload only for 1.1 compiler Revision 1.16 2001/11/24 20:41:04 carl diff --git a/fcl/inc/compon.inc b/fcl/inc/compon.inc index d52546e0d5..6f3b7997cd 100644 --- a/fcl/inc/compon.inc +++ b/fcl/inc/compon.inc @@ -420,6 +420,18 @@ begin end; +function TComponent.ExecuteAction(Action: TBasicAction): Boolean; +begin + if Action.HandlesTarget(Self) then + begin + Action.ExecuteTarget(Self); + Result := True; + end + else + Result := False; +end; + + Function TComponent.FindComponent(const AName: string): TComponent; Var I : longint; @@ -509,9 +521,24 @@ begin SafeCallException:=0; end; + +function TComponent.UpdateAction(Action: TBasicAction): Boolean; +begin + if Action.HandlesTarget(Self) then + begin + Action.UpdateTarget(Self); + Result := True; + end + else + Result := False; +end; + { $Log$ - Revision 1.4 2001-12-03 21:39:58 peter + Revision 1.5 2002-01-06 21:54:50 peter + * action classes added + + Revision 1.4 2001/12/03 21:39:58 peter * seek(int64) overload only for 1.1 compiler Revision 1.3 2001/01/08 18:36:01 sg