tslediter/funcext/tvclib/utslvclaction.tsf

unit utslvclaction;
{**
    @explan(说明) action 接口库
**}
interface
uses utslvclauxiliary,utslvclbase;
type TBasicAction=class(TComponent)
    private
    FActionComponent:TComponent; //执行的tcomponent
    FOnChange:TNotifyEvent;
    FOnExecute:TNotifyEvent;
    FOnUpdate:TNotifyEvent;
    FParent;
    function SetParent(p);
    begin
        if FParent <> p then
        begin
            if FParent is class(TCustomactionlist)then
            begin
                FParent.DeleteAction(self);
            end
            if p is class(TCustomactionlist)then
            begin
                p.AddAction(self);
            end
            Fparent := p;
        end
    end
    protected FClients;
    {**
    @param(FClients)( TFpList of TActionLink) 关联的组件 %%
    **}
    procedure Change;virtual;
    begin
        if iffuncptr(FOnChange) then call(FOnChange,self);
    end
    procedure SetOnExecute(Value:TNotifyEvent);virtual;
    begin
        for i := 0 to FClients.count-1 do
        begin
            FClients[i].SetOnExecute(value);
        end
        FOnExecute := Value;
        Change();
    end
    public
    function Create(AOwner:TComponent);override;
    begin
        inherited;
        FClients := new TFpList();
    end
    function Recycling();override;
    begin
        if FActionComponent then
        begin
            FActionComponent.RemoveFreeNotification(self);
        end
        while FClients.Count>0 do
        begin
            UnRegisterChanges(FClients.Last());
        end
        inherited;
    end
    function Destroy();override;
    begin
        inherited;
    end
    function HandlesTarget(Target:TObject):Boolean;virtual;
    begin
        return false;
    end
    procedure UpdateTarget(Target:TObject);virtual;
    begin
    end
    procedure ExecuteTarget(Target:TObject);virtual;
    begin
    end
    function Execute():Boolean;virtual;
    begin
        if csDesigning in ComponentState then return ;
        if FOnExecute then
        begin
            e := new tuieventbase(0,0,0,0);
            if iffuncptr(FOnExecute) then call(FOnExecute,self(true),e);
            return true;
        end
        return false;
    end
    procedure RegisterChanges(Value:TBasicActionLink);
    begin
        Value.FAction := Self(true);
        FClients.add(Value);
    end
    procedure UnRegisterChanges(Value:TBasicActionLink);
    begin
        for i := 0 to FClients.count-1 do
        begin
            if FClients[i]=Value then
            begin
                Value.FAction := nil;
                FClients.deli(i);
                break;
            end
        end
    end
    function Notification(AComponent,Operation);override;
    begin        
        if Operation=opRecycling and AComponent=FActionComponent then //opRemove
        begin
            FActionComponent := nil;
            if FParent is class(TCustomactionlist)then
            begin
                FParent.DeleteAction(self);
            end
        end
        inherited;
    end
    function SetActionComponent(Value);
    begin
        if FActionComponent <> Value then
        begin
            if FActionComponent is class(TComponent)then FActionComponent.RemoveFreeNotification(self);
            FActionComponent := Value;
            if FActionComponent is class(TComponent)then FActionComponent.FreeNotification(self);
        end
    end
    property ActionComponent:TComponent read FActionComponent write SetActionComponent;
    property onexecute:eventhandler read FOnExecute write SetOnExecute;
    property OnUpdate:TNotifyEvent read FOnUpdate write FOnUpdate;
    property OnChange:TNotifyEvent read FOnChange write FOnChange;
    property parent read FParent Write SetParent;
    {**
    @param(OnExecute)(fpointer) 执行回调 %%
    @param(OnUpdate)(fpointer) 更新回调 %%
    @param(OnChange)(fpointer) 改变回调 %%	
    **}

end;
type TContainedAction=class(TBasicAction)
    function create(AOwner);override;
    begin
        inherited;
    end
    function Destroy();override;
    begin
        inherited;
    end
end


type TCustomAction=class(TContainedAction)
    {**
    @explan(说明) action类 %%
    **}
    private
    FCaption:string;
    FChecked:Boolean;
    FChecking:Boolean;
    FEnabled:Boolean;
    FGroupIndex:Integer;
    FHint:string;
    FVisible:Boolean;
    FShortCut;
    procedure SetCaption(const Value:string);
    begin
        if Value=FCaption then exit;
        for I := 0 to FClients.Count-1 do
        begin
            FClients[I].SetCaption(Value);
        end
        FCaption := Value;
        Change();
    end
    procedure SetChecked(Value:Boolean);
    begin
        if Value=FChecked then exit;
        for I := 0 to FClients.Count-1 do
        begin
            FClients[I].SetChecked(Value);
        end
        FChecked := Value;
        Change();
    end
    procedure SetEnabled(Value:Boolean);
    begin
        nValue := Value?true:false;
        if nValue=FEnabled then exit;
        for I := 0 to FClients.Count-1 do FClients[I].SetEnabled(nValue);
        FEnabled := nValue;
        Change();
    end
    procedure SetVisible(Value:Boolean);
    begin
        nValue := Value?true:false;
        if nValue=FVisible then exit;
        for I := 0 to FClients.Count-1 do FClients[I].SetVisible(nValue);
        FVisible := nValue;
        Change();
    end
    function getShortCut();
    begin
        return  formatshortcut(FShortCut);
    end 

    function SetShortCut(v);
    begin
        if v and ifstring(v) then 
        begin
            nst := parsershortcutstr(v);        
        end else nst := nil;
        if nst <> FShortCut then 
        begin
            FShortCut := nst;
            
            for I := 0 to FClients.Count-1 do
            begin
                FClients[I].SetShortCut(v);
            end
            Change();
        end 
    end 
    protected
    procedure AssignTo(Dest:TPersistent);override;
    begin
        {**
        @explan(说明) 赋值 %%
        **}
        if Dest=Self then exit;
        if Dest is class(TCustomAction)then
        begin
            ps := array("checked","caption","visible","enabled","shortcut");
            for i,v in ps do invoke(Dest,v,1,invoke(self,v));
        end else
        inherited;
    end
    public
    function Create(AOwner:TComponent);override;
    begin
        {**
        @explan(说明) 构造 %%
        **}
        inherited;
        FEnabled := True;
        FVisible := True;
    end
    function Recycling();override;
    begin
        inherited;
    end
    function Destroy;override;
    begin
        inherited;
    end
    function ExecuteCommand(cmd,p);override;
    begin
        if csDesigning in ComponentState then return ;
        if cmd="doshortcut" then 
        begin
            if (FClients and FClients.Count>0) and  Enabled and Visible and ShortCut = p then 
            begin
                if Execute() then return "havedoshortcut";    
            end 
        end 
    end 
    function Execute():Boolean;override;
    begin
        Result := False;
        Result := Enabled and inherited Execute();
        return Result;
    end
    published
    property Caption:string read FCaption write SetCaption;
    property Checked:bool read FChecked write SetChecked;
    property Enabled:bool read FEnabled write SetEnabled;
    property Visible:bool read FVisible write SetVisible;
    property ShortCut:string read getshortcut write SetShortCut;
    function publishs();override;
    begin
        r := array("name","caption","enabled","onexecute");
        return r;
    end
end;
type TCustomactionlist=class(TComponent)
    {**
    @explan(说明) actionlist %%
    **}
    private
    FActionList;
    function DeleteAllActions();
    begin
        while FActionList.Count>0 do
        begin
            it := FActionList[0];
            if it is class(TBasicAction)then
            begin
                it.parent := nil;
            end else
            FActionList.deli(0);
        end
    end
    public
    function create(AOwner);override;
    begin
        inherited;
        FActionList := new TFpList();
    end
    function DeleteAction(v);
    begin
        {**
        @explan(说明) 删除 %%
        @param(v)(TBasicAction)
        **}
        if not(v is class(TBasicAction))then return 0;
        idx := FActionList.indexof(v);
        if not(idx >= 0)then return 0;
        FActionList.deli(idx);
        v.parent := nil;
    end
    function AddAction(V);
    begin
        {**
        @explan(说明) 删除Action %%
        @param(v)(TBasicAction)
        **}
        if v is class(TBasicAction)then
        begin
            if FActionList.indexof(v)>= 0 then return 0;
            FActionList.add(v);
            v.parent := self;
        end
    end
    function Notification(AComponent,Operation);override;
    begin        
        if Operation=opRecycling and AComponent=FActionComponent then //opRemove
        begin
            DeleteAllActions();
        end
        inherited;
    end
    function Recycling();override;
    begin
        DeleteAllActions();
        inherited;
    end
end
type TBasicActionLink=class(TSLUIBASE)
    {**
    @explan(说明) 基础action component关联类 %%
    **}
    private
    FOnChange;
    protected
    procedure AssignClient(AClient:TObject);virtual;
    begin
    end
    procedure Change;virtual;
    begin
        if iffuncptr(FOnChange) then call(OnChange,FAction);
    end
    function IsOnExecuteLinked():Boolean;virtual;
    begin
        return true;
    end
    procedure SetAction(Value:TBasicAction);virtual;
    begin
        if Value <> FAction then
        begin
            if FAction then FAction.UnRegisterChanges(Self(true));
            FAction := Value;
            if Value then Value.RegisterChanges(Self(true));
        end;
    end
    procedure SetOnExecute(Value:TNotifyEvent);virtual;
    begin
    end
    public
    FAction:TBasicAction;
    function Create(AClient:TObject);override;
    begin
        inherited create();
        AssignClient(AClient);
    end
    Function Recycling();override;
    begin
        if FAction is class(TBasicAction)then FAction.UnRegisterChanges(self);
        inherited;
    end
    function Destroy;override;
    begin
        inherited;
    end
    function Execute(AComponent:TComponent):Boolean;virtual;
    begin
        {**
        @explan(说明) 执行 %%
        **}
        if not(FAction is class(TBasicAction))then exit;
        FAction.ActionComponent := AComponent;
        try
            r := FAction.Execute();
        finally
            FAction.ActionComponent := nil;        
        end;
        return r;
    end
    {function Update(): Boolean; virtual;
    begin
    if FAction is class(TBasicAction) then return FAction.Update();
    end }
    property Action:TBasicAction read FAction write SetAction;
    property OnChange:TNotifyEvent read FOnChange write FOnChange;
    {**
    @param(OnChange)(function[sender:tcomponent]) 改变的回调 %%
    @param(Action)(taction) action对象 %%
    **}
end;
type TActionLink=class(TBasicActionLink)
    {**
    @explan(说明) action与控件连接类 %%
    **}
    public
    procedure SetShortCut(const Value:String);virtual;
    begin
    end 
    procedure SetCaption(const Value:string);virtual;
    begin
    end
    procedure SetChecked(Value:Boolean);virtual;
    begin
    end
    procedure SetEnabled(Value:Boolean);virtual;
    begin
    end
    procedure SetVisible(Value:Boolean);virtual;
    begin
    end
    function create(AClient);override;
    begin
        inherited;
    end
    protected
    function IsshortcutLinked():Boolean;virtual;
    begin
        return Action is CLASS(TCustomAction);
    end 
    function IsCheckedLinked():Boolean;virtual;
    begin
        return Action is CLASS(TCustomAction);
    end
    function IsEnabledLinked():Boolean;virtual;
    begin
        return Action is CLASS(TCustomAction);
    end
    function IsCaptionLinked():Boolean;virtual;
    begin
        return Action is CLASS(TCustomAction);
    end
    function IsOnExecuteLinked():Boolean;virtual;
    begin
        return Action is CLASS(TCustomAction);
    end
    function IsVisibleLinked():Boolean;virtual;
    begin
        return Action is CLASS(TCustomAction);
    end
end;

type TControlActionLink=class(TActionLink)
    {**
    @explan(说明)关联tcontrol 和 taction 类 %%
    **}
    protected 
    FClient:TControl;
    function IsshortcutLinked():Boolean;virtual;
    begin
        return false;
    end 
    procedure AssignClient(AClient);override;
    begin
        {**
        @explan(说明)赋值control %%
        @param(AClient)(tcontrol) %%
        **}
        if AClient is class(tcontrol)then FClient := AClient;
    end
    function IsCaptionLinked():Boolean;override;
    begin
        return FClient and inherited;
    end
    function IsEnabledLinked():Boolean;override;
    begin
        return FClient and inherited;
    end
    function IsVisibleLinked():Boolean;override;
    begin
        return FClient and inherited;
    end
    function IsOnExecuteLinked():Boolean;override;
    begin
        return FClient and inherited;
    end
    function IsCheckedLinked():Boolean;virtual;
    begin
        return false;
    end    
    public
    function create(AClient);override;
    begin
        inherited;
    end
    function destroy();override;
    begin
        inherited;
    end
    function Recycling();override;
    begin
        FClient := nil;
        inherited;
    end
    procedure SetCaption(const Value:string);override;
    begin
        if IsCaptionLinked()then return FClient.Caption := Value;
    end
    procedure SetEnabled(Value:Boolean);override;
    begin
        if IsEnabledLinked()then return FClient.Enabled := Value;
    end
    procedure SetVisible(Value:Boolean);override;
    begin
        if IsVisibleLinked()then return FClient.Visible := Value;
    end
    procedure SetOnExecute(Value:TNotifyEvent);override;
    begin
        return inherited;
    end    
end;
implementation

initialization

end.