{ ******************************************************************************* Copyright 2016-2019 Daniele Spinetti Licensed under the Apache License, Version 2.0 (the "License"); you may not use this file except in compliance with the License. You may obtain a copy of the License at http://www.apache.org/licenses/LICENSE-2.0 Unless required by applicable law or agreed to in writing, software distributed under the License is distributed on an "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. See the License for the specific language governing permissions and limitations under the License. ******************************************************************************** } unit Router4D.Props; interface uses System.Classes, System.SysUtils, System.Rtti; type TThreadMode = (Posting, Main, Async, Background); TCloneEventCallback = function(const AObject: TObject): TObject of object; TCloneEventMethod = TFunc; IEventBus = Interface ['{7BDF4536-F2BA-4FBA-B186-09E1EE6C7E35}'] procedure RegisterSubscriber(ASubscriber: TObject); function IsRegistered(ASubscriber: TObject): Boolean; procedure Unregister(ASubscriber: TObject); procedure Post(AEvent: TObject; const AContext: String = ''; AEventOwner: Boolean = true); procedure SetOnCloneEvent(const aCloneEvent: TCloneEventCallback); procedure AddCustomClassCloning(const AQualifiedClassName: String; const aCloneEvent: TCloneEventMethod); procedure RemoveCustomClassCloning(const AQualifiedClassName: String); property OnCloneEvent: TCloneEventCallback write SetOnCloneEvent; end; SubscribeAttribute = class(TCustomAttribute) private FContext: String; FThreadMode: TThreadMode; public constructor Create(AThreadMode: TThreadMode = TThreadMode.Posting; const AContext: String = ''); property ThreadMode: TThreadMode read FThreadMode; property Context: String read FContext; end; TDEBEvent = class(TObject) private FDataOwner: Boolean; FData: T; procedure SetData(const Value: T); procedure SetDataOwner(const Value: Boolean); public constructor Create; overload; constructor Create(AData: T); overload; destructor Destroy; override; property DataOwner: Boolean read FDataOwner write SetDataOwner; property Data: T read FData write SetData; end; TProps = class private FPropString: String; FPropInteger: Integer; FPropCurrency : Currency; FPropDouble : Double; FPropValue : TValue; FPropObject : TObject; FPropDateTime : TDateTime; FKey : String; public constructor Create; destructor Destroy; override; function PropString ( aProp : String ) : TProps; overload; function PropString : String; overload; function PropInteger ( aProp : Integer ) : TProps; overload; function PropInteger : Integer; overload; function PropCurrency ( aProp : Currency ) : TProps; overload; function PropCurrency : Currency; overload; function PropDouble ( aProp : Double ) : TProps; overload; function PropDouble : Double; overload; function PropValue ( aProp : TValue ) : TProps; overload; function PropValue : TValue; overload; function PropObject ( aProp : TObject ) : TProps; overload; function PropObject : TObject; overload; function PropDateTime ( aProp : TDateTime ) : TProps; overload; function PropDateTime : TDateTime; overload; function Key ( aKey : String ) : TProps; overload; function Key : String; overload; end; function GlobalEventBus: IEventBus; implementation uses EventBus.Core, RTTIUtilsU; var FGlobalEventBus: IEventBus; { SubscribeAttribute } constructor SubscribeAttribute.Create(AThreadMode : TThreadMode = TThreadMode.Posting; const AContext: String = ''); begin inherited Create; FContext := AContext; FThreadMode := AThreadMode; end; { TDEBSimpleEvent } constructor TDEBEvent.Create(AData: T); begin inherited Create; DataOwner := true; Data := AData; end; constructor TDEBEvent.Create; begin inherited Create; end; destructor TDEBEvent.Destroy; var LValue: TValue; begin LValue := TValue.From(Data); if (LValue.IsObject) and DataOwner then LValue.AsObject.Free; inherited; end; procedure TDEBEvent.SetData(const Value: T); begin FData := Value; end; procedure TDEBEvent.SetDataOwner(const Value: Boolean); begin FDataOwner := Value; end; function GlobalEventBus: IEventBus; begin if not Assigned(FGlobalEventBus) then FGlobalEventBus := TEventBus.Create; Result := FGlobalEventBus; end; { TProps } constructor TProps.Create; begin end; destructor TProps.Destroy; begin inherited; end; function TProps.Key(aKey: String): TProps; begin Result := Self; FKey := aKey; end; function TProps.Key: String; begin Result := FKey; end; function TProps.PropCurrency: Currency; begin Result := FPropCurrency; end; function TProps.PropDateTime: TDateTime; begin Result := FPropDateTime; end; function TProps.PropDateTime(aProp: TDateTime): TProps; begin Result := Self; FPropDateTime := aProp; end; function TProps.PropDouble: Double; begin Result := FPropDouble; end; function TProps.PropDouble(aProp: Double): TProps; begin Result := Self; FPropDouble := aProp; end; function TProps.PropCurrency(aProp: Currency): TProps; begin Result := Self; FPropCurrency := aProp; end; function TProps.PropInteger: Integer; begin Result := FPropInteger; end; function TProps.PropObject: TObject; begin Result := FPropObject; end; function TProps.PropObject(aProp: TObject): TProps; begin Result := Self; FPropObject := aProp; end; function TProps.PropInteger(aProp: Integer): TProps; begin Result := Self; FPropInteger := aProp; end; function TProps.PropString(aProp: String): TProps; begin Result := Self; FPropString := aProp; end; function TProps.PropString: String; begin Result := FPropString; end; function TProps.PropValue: TValue; begin Result := FPropValue; end; function TProps.PropValue(aProp: TValue): TProps; begin Result := Self; FPropValue := aProp; end; initialization GlobalEventBus; finalization end.