mmobsrv.pas

一套及时通讯的原码

{========================================================================}
{=                (c) 1995-98 SwiftSoft Ronald Dittrich                 =}
{========================================================================}
{=                          All Rights Reserved                         =}
{========================================================================}
{=  D 01099 Dresden             = Fax.: [phone]              =}
{=  Loewenstr.7a                = [e-mail]                     =}
{========================================================================}
{=  Actual versions on http://www.swiftsoft.de/mmtools.html             =}
{========================================================================}
{=  This code is for reference purposes only and may not be copied or   =}
{=  distributed in any format electronic or otherwise except one copy   =}
{=  for backup purposes.                                                =}
{=                                                                      =}
{=  No Delphi Component Kit or Component individually or in a collection=}
{=  subclassed or otherwise from the code in this unit, or associated   =}
{=  .pas, .dfm, .dcu, .asm or .obj files may be sold or distributed     =}
{=  without express permission from SwiftSoft.                          =}
{=                                                                      =}
{=  For more licence informations please refer to the associated        =}
{=  HelpFile.                                                           =}
{========================================================================}
{=  $Date: 06.03.98 - 05:57:28 $                                        =}
{========================================================================}
unit MMObsrv;

{$I COMPILER.INC}

interface

uses
    Classes;

type
    TMMObsNotifyEvent   = procedure(Sender: TObject; Data: TObject) of object;
    TMMObservable       = class;

    {-- TMMObserver -----------------------------------------------------}
    TMMObserver = class(TObject)
    private
       FObservable: TMMObservable;
       FLocked    : Integer;
       FOnNotify  : TMMObsNotifyEvent;
    protected
       procedure Notify(Data: TObject); virtual;
       procedure DoNotify(Data: TObject);
       function  GetLocked: Boolean;
   public
       destructor Destroy; override;

       procedure Lock;
       procedure UnLock;

       property OnNotify: TMMObsNotifyEvent read FOnNotify write FOnNotify;
       property Locked: Boolean read GetLocked;
    end;

    {-- TMMObservable -------------------------------------------------------}
    TMMObservable = class(TObject)
    private
       FObservers: TList;
       FLock     : Integer;
    public
       constructor Create;
       destructor  Destroy; override;

       procedure Lock;
       procedure Unlock;
       function  LockCount: Integer;

       procedure NotifyObservers(Data: TObject);
       procedure AddObserver(O: TMMObserver);
       procedure RemoveObserver(O: TMMObserver);
    end;

{========================================================================}
implementation
{========================================================================}


{== TMMObserver =========================================================}
destructor  TMMObserver.Destroy;
begin
   if (FObservable <> nil) then
      FObservable.RemoveObserver(Self);
   inherited Destroy;
end;

{-- TMMObserver ---------------------------------------------------------}
procedure TMMObserver.DoNotify(Data: TObject);
begin
   if Assigned(FOnNotify) then FOnNotify(Self, Data);
end;

{-- TMMObserver ---------------------------------------------------------}
procedure TMMObserver.Notify(Data: TObject);
begin
   if FLocked = 0 then DoNotify(Data);
end;

{-- TMMObserver ---------------------------------------------------------}
procedure TMMObserver.Lock;
begin
   Inc(FLocked);
end;

{-- TMMObserver ---------------------------------------------------------}
procedure TMMObserver.UnLock;
begin
   Dec(FLocked);
end;

{-- TMMObserver ---------------------------------------------------------}
function TMMObserver.GetLocked: Boolean;
begin
   Result := FLocked <> 0;
end;

{== TMMObservable =======================================================}
constructor TMMObservable.Create;
begin
   inherited Create;

   FObservers := TList.Create;
end;

{-- TMMObservable -------------------------------------------------------}
destructor TMMObservable.Destroy;
begin
   if FObservers <> nil then
   begin
      while FObservers.Count > 0 do
            RemoveObserver(TMMObserver(FObservers.Last));

      FObservers.Free;
   end;

   inherited Destroy;
end;

{-- TMMObservable -------------------------------------------------------}
procedure TMMObservable.NotifyObservers(Data: TObject);
var
    i: Integer;
begin
   if (FObservers = nil) or (FLock <> 0) then Exit;

   for i:= FObservers.Count - 1 downto 0 do
       TMMObserver(FObservers[i]).Notify(Data);
end;

{-- TMMObservable -------------------------------------------------------}
procedure TMMObservable.AddObserver(O: TMMObserver);
begin
   if (O = nil) or (FObservers = nil) then
      Exit;

   if O.FObservable <> nil then
      O.FObservable.RemoveObserver(O);

   O.FObservable:= nil;
   FObservers.Add(O);
   O.FObservable:= Self;
end;

{-- TMMObservable -------------------------------------------------------}
procedure TMMObservable.RemoveObserver(O: TMMObserver);
begin
   if (O = nil) or (O.FObservable <> Self) or (FObservers = nil) then
       Exit;

   FObservers.Remove(O);
   O.FObservable:= nil;
end;

{-- TMMObservable -------------------------------------------------------}
procedure TMMObservable.Lock;
begin
   Inc(FLock);
end;

{-- TMMObservable -------------------------------------------------------}
procedure TMMObservable.Unlock;
begin
   Dec(FLock);
end;

{-- TMMObservable -------------------------------------------------------}
function TMMObservable.LockCount: Integer;
begin
   Result := FLock;
end;

end.