Çoklu Olay Yöneticisi

[Tuğrul HELVACI]

Amaç: Delphi'ye de C#'daki gibi çoklu olay tanımlayabilme özelliğini getirebilmek.

Elimizdeki yapı:

TTest = class
  private
   fClick: TNotifyEvent;

   function GetClick : TNotifyEvent;
   procedure SetClick(const Value : TNotifyEvent);
 public
   procedure Click;

   property OnClick : TNotifyEvent read GetClick write SetClick;
 end;

İstenen:

procedure TForm1.MyClick1(Sender: TObject);
begin
 ShowMessage('1');
end;

procedure TForm1.MyClick2(Sender: TObject);
begin
 ShowMessage('2');
end;

procedure TForm1.MyClick3(Sender: TObject);
begin
 ShowMessage('3');
end;

procedure TForm1.MyClick4(Sender: TObject);
begin
 ShowMessage('4');
end;

procedure TForm1.Button1Click(Sender: TObject);
var
 test : TTest;
begin
  test := TTest.Create;

  try
    test.OnClick := MyClick1;
    test.OnClick := MyClick2;
    test.OnClick := MyClick3;
    test.OnClick := MyClick4;
     test.Click;
  finally
     test.Free;
  end;
end;

Ekranda sırası ile; 1,2,3 ve 4 mesajlarını görmemiz gerekiyor. İlgili sınıfa istediğiniz gibi ekleme ve çıkartma yapabilirsiniz.

Not: 10 puan değerindedir.

[savasabd]

unit Unit4;

interface

uses
 Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
 Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls;
    type
   TTest = class
 private
  fClick: TNotifyEvent; //bunu dizi tanımladığım için kullanmadım ama ilk elemeanı yada son elemanı bunda tutabiliriz de
  count: integer;
   ArrfClick:Array of TNotifyEvent;
  function GetClick : TNotifyEvent;
  procedure SetClick(const Value : TNotifyEvent);
public
  procedure Click;

  property OnClick : TNotifyEvent read GetClick write SetClick;
end;

 TForm1 = class(TForm)
   Button1: TButton;
   procedure Button1Click(Sender: TObject);
   procedure MyClick1(Sender: TObject);
   procedure MyClick2(Sender: TObject);
   procedure MyClick3(Sender: TObject);
   procedure MyClick4(Sender: TObject);
 private
   { Private declarations }
 public
   { Public declarations }
 end;


var
 Form1: TForm1;

implementation

{$R *.dfm}
 function TTest.GetClick : TNotifyEvent;
 begin
  result:=ArrfClick[0];//1 elemanı veriyoruz buradan dizinin başlangıç adresini alabiliriz
 end;
  procedure TTest.SetClick(const Value : TNotifyEvent);
  begin
     inc(count);
   if length(ArrfClick)<count then setlength(ArrfClick,count*2); //Eğer dizi yetersizse büyütüyoruz
   //olay metodumuzu ekliyoruz
    ArrfClick[count-1]:=Value;   //burada bir for döngüsüyle kontrol edilip aynı adrese sahip fonksiyonu eklemeyebiliriz de
  end;

  procedure TTest.Click;
  var
  i:integer;
  begin
  for I := Low(ArrfClick) to High(ArrfClick) do
  begin
  if (@ArrfClick[i] <>nil)   // fonksiyon tanımlıysa çağırıyoruz
  then ArrfClick[i](self);

  end;


  end;

procedure TForm1.MyClick1(Sender: TObject);
begin
ShowMessage('1');
end;

procedure TForm1.MyClick2(Sender: TObject);
begin
ShowMessage('2');
end;

procedure TForm1.MyClick3(Sender: TObject);
begin
ShowMessage('3');
end;

procedure TForm1.MyClick4(Sender: TObject);
begin
ShowMessage('4');
end;

procedure TForm1.Button1Click(Sender: TObject);
var
test : TTest;
begin
 test := TTest.Create;

 try
   test.OnClick := MyClick1;
   test.OnClick := MyClick2;
   test.OnClick := MyClick3;
   test.OnClick := MyClick4;
    test.Click;
 finally
    test.Free;
 end;
end;


end.

[Tuğrul HELVACI]

Ellerinize sağlık. Benim de çözümüm aşağıdaki gibidir:

  TTest = class
 private
   fEvents : TList<TNotifyEvent>;

   function GetClick : TNotifyEvent;
   procedure SetClick(const Value : TNotifyEvent);
 public
   constructor Create;
   destructor Destroy; override;

   procedure Click;

   property OnClick : TNotifyEvent read Getclick write SetClick;
 end;

var
 Form1: TForm1;

implementation

{$R *.dfm}

{ TTest }

procedure TTest.Click;
var
 evt : TNotifyEvent;
 mtd : TMethod;
begin
 if fEvents.Count > 0 then
   for evt in fEvents do
   begin
     mtd.Code := @evt;
     mtd.Data := Self;
     TNotifyEvent(mtd)(Self);
   end;
end;

constructor TTest.Create;
begin
 fEvents := TList<TNotifyEvent>.Create;
end;

destructor TTest.Destroy;
begin
 fEvents.Clear;
 fEvents.Free;

 inherited;
end;

function TTest.GetClick: TNotifyEvent;
begin
 Result := fEvents.Items[0];
end;

procedure TTest.SetClick(const Value: TNotifyEvent);
begin
 fEvents.Add(Value);
end;

procedure TForm1.Button1Click(Sender: TObject);
var
 test : TTest;
begin
 test := TTest.Create;
 test.OnClick := MyClick1;
 test.OnClick := MyClick2;
 test.OnClick := MyClick3;
 test.OnClick := MyClick4;
 test.Click;
 test.Free;
end;

procedure TForm1.MyClick1(Sender: TObject);
begin
 ShowMessage('1');
end;

procedure TForm1.MyClick2(Sender: TObject);
begin
 ShowMessage('2');
end;

procedure TForm1.MyClick3(Sender: TObject);
begin
 ShowMessage('3');
end;

procedure TForm1.MyClick4(Sender: TObject);
begin
 ShowMessage('4');
end;

[SimaWB]

Bana "Observer Pattern"i hatırlattı

[Tuğrul HELVACI]

Malumunuz ilgili pattern Delphi içinde pek çok yerde kullanılmaktadır. Örneğin componentlerin published property'lerinden biri bir başka component türünde ise, ilgili component'in container üzerinden silinmesi durumundan haberdar olunabilmesi için Notification metodu; ya da Owner mekanizması buna örnek gösterilebilir.

[veteran]

program ievent_dispatch;

{$APPTYPE CONSOLE}

{$R *.res}

//
// veteran
// 24-08-2023
//

uses
 System.Generics.Collections,
 System.SysUtils;

type
 INotify = interface
 ['{4E9C3369-8313-40F9-AB68-D8D5E93E208D}']
   procedure Event( inSender : TObject );
 end;

 TDispatcher = class
 private var
   m_objTargets : TList<INotify>;
 private
   function GetCount() : Integer; inline;
 public
   constructor Create();
   destructor Destroy(); override;
   procedure &Register( inTarget : TInterfacedObject );
   procedure Unregister( inTarget : TInterfacedObject );
   procedure DoEvent( inSender : TObject );
   property Count : Integer read GetCount;
 end;


{$REGION ' TDispatcher '}

// Private

function TDispatcher.GetCount;
begin
 Result := m_objTargets.Count;
end;

// Public

constructor TDispatcher.Create;
begin
 m_objTargets := TList<INotify>.Create();
end;

destructor TDispatcher.Destroy;
begin
 m_objTargets.Destroy();
 inherited;
end;

procedure TDispatcher.&Register;
var
 l_objT : INotify;
begin
 l_objT := inTarget as INotify;

 if Assigned(l_objT)
 and (not m_objTargets.Contains( l_objT )) then
   m_objTargets.Add( l_objT );
end;

procedure TDispatcher.Unregister;
var
 l_objT : INotify;
begin
 l_objT := inTarget as INotify;

 if Assigned(l_objT) then
   m_objTargets.Remove( l_objT );
end;

procedure TDispatcher.DoEvent;
var
 l_objT : INotify;
begin
 for l_objT in m_objTargets do
   l_objT.Event( inSender );
end;

{$ENDREGION}

type
 A = class(TInterfacedObject, INotify)
   procedure Event( inSender : TObject );
 end;

 B = class(TInterfacedObject, INotify)
   procedure Event( inSender : TObject );
 end;

var
 A_ : array[ 0..3 ] of A;
 B_ : array[ 0..3 ] of B;

 D_ : TDispatcher;

 i  : Integer;

{ A }

procedure A.Event( inSender : TObject );
begin
 WriteLn( 'A.Event' );
end;

{ B }

procedure B.Event( inSender : TObject );
begin
 WriteLn( 'B.Event' );
end;

begin
 try

   D_ := TDispatcher.Create();

   for i := 0 to 3 do
   begin
     A_[ i ] := A.Create();
     B_[ i ] := B.Create();

     D_.Register( A_[ i ] );
     D_.Register( B_[ i ] );
   end;

   WriteLn;

   WriteLn( 'Notify Event Count: ', D_.Count );

   WriteLn;

   D_.DoEvent( TObject(nil) );

 except
   on E: Exception do
     Writeln(E.ClassName, ': ', E.Message);
 end;
end.