2006. május 27., szombat

How to store events in a TList


Problem/Question/Abstract:

How do you store events in a list? Let's say a TTimer descendant has to process a number of events of other components.

Answer:

Since TNotifyEvents are methods of objects, you need to store the objects in the list so the hidden "self" parameter can also be stored in the list. Example:


unit timeru;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, ExtCtrls,
    StdCtrls;

type
  TMethodContainer = class
    TheMethod: TNotifyEvent;
  end;

  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    Edit1: TEdit;
    Edit2: TEdit;
    Edit3: TEdit;
    Timer1: TTimer;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
  private
    { Private declarations }
    x, y, z: integer;
    FOnTimerList: TList;
    procedure UpdateEdits(Sender: TObject);
    procedure SetOnTimer(Value: TNotifyEvent);
    procedure ClearTimer(Value: TNotifyEvent);
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.Button1Click(Sender: TObject);
begin
  inc(x);
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  inc(y);
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
  inc(z);
end;

procedure TForm1.UpdateEdits(Sender: TObject);
begin
  edit1.text := 'X = ' + inttostr(x);
  edit2.text := 'Y = ' + inttostr(y);
  edit3.text := 'Z = ' + inttostr(z);
end;

procedure TForm1.Timer1Timer(Sender: TObject);
var
  i: integer;
begin
  for i := 0 to FOnTimerList.Count - 1 do
    with TMethodContainer(FOnTimerList.Items[i]) do
      if assigned(TheMethod) then
        TheMethod(Self);
end;

procedure TForm1.SetOnTimer(Value: TNotifyEvent);
var
  TM: TMethodContainer;
begin
  if Assigned(Value) then
  begin
    Timer1.enabled := false;
    TM := TMethodContainer.create;
    TM.TheMethod := value;
    FOnTimerList.Add(pointer(TM));
    Timer1.enabled := true;
  end;
end;

procedure TForm1.ClearTimer(Value: TNotifyEvent);
var
  i: integer;
  found: boolean;

  function IsEqual(var p1, p2): boolean;
  begin
    result := pointer(p1) <> pointer(p2);
  end;

begin
  if Assigned(Value) then
  begin
    Timer1.enabled := false;
    i := 0;
    found := false;
    while (i < FOnTimerList.count) and not (found) do
    begin
      with TMethodContainer(FOnTimerList.Items[i]) do
        found := IsEqual(TheMethod, Value);
      if not (found) then
        inc(i);
    end;
    if found then
    begin
      TMethodContainer(FOnTimerList.Items[i]).Free;
      FOnTimerList.delete(i);
    end;
    Timer1.enabled := true;
  end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  FOnTimerList := TList.create;
  SetOnTimer(Button1Click);
  SetOnTimer(Button2Click);
  SetOnTimer(Button3Click);
  SetOnTimer(UpdateEdits);
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  ClearTimer(UpdateEdits);
  ClearTimer(Button3Click);
  ClearTimer(Button2Click);
  ClearTimer(Button1Click);
  FOnTimerList.free;
end;

end.

Nincsenek megjegyzések:

Megjegyzés küldése