DBMS/UNotifications.pas at master · ptsolg/DBMS · GitHub

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
unit UNotifications;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, Dialogs, UVector;

type

  TEvent = procedure of object;
  TNotificationEvent = procedure(Sender: TObject) of object;
  //Notification class
  TNClass = array of integer;
  TSubscriber = class;

  TSubscriber = class
  private
    type
    TSubsribers = specialize TObjVector<TSubscriber>;
  private
    FRecieveAll: boolean;
    FRecieveEnable: boolean;
    FSendEnable: boolean;
    FNClass: TNClass;
    FParent: TSubscriber;
    FSubscribers: TSubsribers;
    FOnRecieve: TNotificationEvent;
    function Containing(ANotificationClass: TNClass): boolean;
    procedure NotificationRecieve(Sender: TObject; ANClass: TNClass);
    procedure NotifySubscribers(Sender: TObject; ANClass: TNClass);
  public
    constructor Create(RecieveAll: boolean = False);
    destructor Destroy; override;
    procedure Subscribe(Subscriber: TSubscriber);
    procedure UnSubscribe(Subscriber: TSubscriber);
    procedure CreateNotification(Sender: TObject; ANClass: TNClass);
  published
    property OnNotificationRecieve: TNotificationEvent write FOnRecieve;
    property Parent: TSubscriber read FParent write FParent;
    property NClass: TNClass read FNClass write FNClass;
  end;

function ToNClass(A: array of integer): TNClass;

implementation

function ToNClass(A: array of integer): TNClass;
var
  i: integer;
begin
  SetLength(Result, Length(A));
  for i := 0 to High(A) do
    Result[i] := A[i];
end;

constructor TSubscriber.Create(RecieveAll: boolean = False);
begin
  FParent := nil;
  FOnRecieve := nil;
  FSubscribers := TSubsribers.Create;
  FRecieveAll := RecieveAll;
  FSendEnable := True;
  FRecieveEnable := True;
end;

destructor TSubscriber.Destroy;
begin
  if FParent <> nil then
    FParent.UnSubscribe(Self);
  FSubscribers.Free;
  inherited Destroy;
end;

function TSubscriber.Containing(ANotificationClass: TNClass): boolean;
var
  i: integer;
  j: integer;
begin
  if FRecieveAll then
    Exit(True);
  if not FRecieveEnable then
    Exit(False);
  for i := 0 to Length(FNClass) - 1 do
    for j := 0 to Length(ANotificationClass) - 1 do
      if (FNClass[i] = ANotificationClass[j]) then
        Exit(True);
  Exit(False);
end;

procedure TSubscriber.Subscribe(Subscriber: TSubscriber);
begin
  FSubscribers.PushBack(Subscriber);
  Subscriber.Parent := Self;
end;

procedure TSubscriber.UnSubscribe(Subscriber: TSubscriber);
var
  Index: integer;
begin
  Index := FSubscribers.FindInd(Subscriber);
  if Index <> -1 then
    FSubscribers.DeleteInd(Index);
end;

procedure TSubscriber.CreateNotification(Sender: TObject; ANClass: TNClass);
var
  Iterator: TSubscriber;
begin
  Iterator := Self;
  while (Iterator.FParent <> nil) and (Iterator.FParent.Containing(NClass)) do
    Iterator := Iterator.FParent;
  Iterator.NotifySubscribers(Sender, ANClass);
end;

procedure TSubscriber.NotificationRecieve(Sender: TObject; ANClass: TNClass);
begin
  if not FRecieveEnable then
    Exit;
  if FOnRecieve <> nil then
    FOnRecieve(Sender);
  NotifySubscribers(Sender, ANClass);
end;

procedure TSubscriber.NotifySubscribers(Sender: TObject; ANClass: TNClass);
var
  i: integer;
begin
  for i := 0 to FSubscribers.Size - 1 do
    if FSubscribers[i].Containing(ANClass) then
      FSubscribers[i].NotificationRecieve(Sender, ANClass);
end;

end.