fpc/rtl/objpas/classes/action.inc

{%MainUnit classes.pp}
{
    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
  if not Assigned(FAction) then 
    exit;
  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
  if Assigned(Faction) then
    Result := FAction.Update
  else
    Result:=False;
end;

{****************************************************************************}
{*                             TBasicAction                                 *}
{****************************************************************************}

constructor TBasicAction.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FClients := TFpList.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;

function TBasicAction.Suspended: Boolean;
begin
  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;

function TBasicAction.ClientCount: Integer;
begin
  Result:=FClients.Count;
end;

function TBasicAction.GetClient(Idx: Integer): TObject;
begin
  Result:=TObject(FClients[Idx]);
end;

procedure TBasicAction.SetActionComponent(AValue: TComponent);
begin
  if FActionComponent=AValue then Exit;
  if Assigned(FActionComponent) then
     FActionComponent.RemoveFreeNotification(Self);
  FActionComponent:=AValue;
  if Assigned(FActionComponent) then
     FActionComponent.FreeNotification(Self);
end;

procedure TBasicAction.Change;
begin
  if Assigned(FOnChange) then
    FOnChange(Self);
end;

procedure TBasicAction.Notification(AComponent: TComponent;
  Operation: TOperation);
begin
  inherited Notification(AComponent, Operation);
  if (Operation<>OpRemove) then
    exit;
  if (AComponent=FActionComponent) then
    FActionComponent:=nil;
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;