VPF::Несколько обработчиков на событие. Не наследование

SpaceIQ

Дата 2.7.2009, 16:52 (ссылка)

(нет голосов)

Загрузка ...

Новичок

Профиль
Группа: Участник
Сообщений: 11
Регистрация: 2.7.2009

Репутация: нет
Всего: нет

Кто как устанавливает несколько обработчиков на одно событие?

У меня есть способ, но у него есть одно нехорошое следсвие.

Например, у меня есть TComboBox с установленным событиями OnChange. При выборе опредленного значения из списка просходит отключение тех или иных частей формы.

Но так же есть и некоторый класс, которому необходимо использовать событие OnChange этого списка.

То есть два обработчика:
StandartFunction - метод формы, определяется как обычно, например двойным нажатием на виджету на форме.
NewFunction - метод внешнего класса.

Я делаю так:

1. Внутри класса, перед изменение обработчка события, сохраняю ссылку на старый обработчик:

Код


StandartFunctionPointer := @Widget.OnChange;
Widget.OnChange := NewFunction;

2. Внутри нового обработчика (NewFunction) пишу вызов старого:

Код


@Widget.OnChange := StandartFunctionPointer;
TEdit.OnChange( Self );

3. Потом опять устанавливаю новый обработчик NewFunction, по аналогии в первом шаге.

Но при таком способе [TEdit.OnChange( Self )] в обработчике StandartFunction нельзя обратиться к форме через Self, почему то стандартный метод обработки теперь рассмативается как внешний.

Какие мысли у кого есть по этому поводу? Или может другие способы установки нескольких обработчиков?

Это сообщение отредактировал(а) SpaceIQ - 2.7.2009, 17:11

Rennigth

Дата 2.7.2009, 17:38 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Участник Клуба
Сообщений: 1708
Регистрация: 21.6.2004
Где: Moscow

Репутация: 49
Всего: 76

SpaceIQ,
что-то ты немного перемудрил... вообщем примерно вот так:

Код


unit Unit2;

interface

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

type
  TSomeObject = class
  private
    FSaveNotifyEvent: TNotifyEvent;
  public
    property SaveNotifyEvent: TNotifyEvent read FSaveNotifyEvent write FSaveNotifyEvent;
    procedure Change(ASender: TObject);
  end;


  TForm2 = class(TForm)
    edt1: TEdit;
    procedure edt1Change(Sender: TObject);
  private
    FSomeObject: TSomeObject;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  end;


var
  Form2: TForm2;

implementation

{$R *.dfm}

constructor TForm2.Create(AOwner: TComponent);
begin
  inherited;
  FSomeObject := TSomeObject.Create;
  FSomeObject.FSaveNotifyEvent := edt1.OnChange;
  edt1.OnChange := FSomeObject.Change;
end;

destructor TForm2.Destroy;
begin
  FSomeObject.Free;
  inherited;
end;

procedure TForm2.edt1Change(Sender: TObject);
begin
  ShowMessage(Sender.ClassName);
end;

{ TSomeObject }

procedure TSomeObject.Change(ASender: TObject);
begin
  if Assigned(FSaveNotifyEvent) then
    FSaveNotifyEvent(ASender);
end;

end.

--------------------

(* Honesta mors turpi vita potior *)

Frees

Дата 3.7.2009, 07:35 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Завсегдатай
Сообщений: 2233
Регистрация: 2.12.2005
Где: Екатеринбург

Репутация: 9
Всего: 54

Цитата(SpaceIQ @ 2.7.2009, 19:52

)

Кто как устанавливает несколько обработчиков на одно событие?

вот еще вариант

Код


type
  TEvents  = class
  private
    FEventList: TList;
    FListenObject: TObject;
  public
    procedure OnEvent(Sender: TObject);
    constructor Create(ListenObject: TObject);
    destructor Destroy; override;
    procedure AddEvent(Event: TNotifyEvent);
  end;

  TForm25 = class(TForm)
   //...
  end;

var
  Form25: TForm25;

implementation

{$R *.dfm}

{ TEvents }

procedure TEvents.AddEvent(Event: TNotifyEvent);
begin
  if Assigned(Event) then
    FEventList.Add(@Event);
end;

constructor TEvents.Create(ListenObject: TObject);
var
begin
  inherited Create;
  FEventList := TList.Create;
  FListenObject := ListenObject;
end;

destructor TEvents.Destroy;
begin
  FEventList.Free;
  inherited Destroy;
end;

procedure TEvents.OnEvent(Sender: TObject);
var
  I: Integer;
  ne: TNotifyEvent;
begin
  for I := 0 to FEventList.Count - 1 do
    if Assigned(FEventList.Items[i]) then
    begin
      @ne :=  FEventList.Items[i];
      ne(FListenObject);
    end;
end;

procedure TForm25.Button1Click(Sender: TObject);
begin
  ShowMessage('Button1Click');
end;
procedure TForm25.Button2Click(Sender: TObject);
begin
  ShowMessage('Button2Click');
end;
procedure TForm25.Button3Click(Sender: TObject);
begin
  ShowMessage('Button3Click');
end;

procedure TForm25.FormCreate(Sender: TObject);
begin
  Events := TEvents.Create(Button1);
  Button1.OnClick := Events.OnEvent;
  Events.AddEvent(Button1Click);
  Events.AddEvent(Button2Click);
  Events.AddEvent(Button3Click);
end;

procedure TForm25.FormClose(Sender: TObject);
begin
  Events.Free;
end;
end.

Это сообщение отредактировал(а) Frees - 3.7.2009, 07:42

--------------------

Кольцов Виктор Владимирович

MetalFan

Дата 3.7.2009, 08:45 (ссылка)

(нет голосов)

Загрузка ...

Аццкий Сотона

Профиль
Группа: Комодератор
Сообщений: 3815
Регистрация: 2.10.2006
Где: Moscow

Репутация: 62
Всего: 128

Frees, хм, а это точно работает без ошибок? имеется мнение, что @Event не имеет смысла, ибо Event динамическая запись из двух указателей...
я делал нечто подобное, только хранил два указателя (TMethod).

--------------------

There are always someone smarter than you...

Frees

Дата 3.7.2009, 09:02 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Завсегдатай
Сообщений: 2233
Регистрация: 2.12.2005
Где: Екатеринбург

Репутация: 9
Всего: 54

Цитата(MetalFan @ 3.7.2009, 11:45

)

хм, а это точно работает без ошибок

работает но с пристрастием не тестил

Цитата(MetalFan @ 3.7.2009, 11:45

)

что @Event не имеет смысла

ты это место имееш в виду

Код


      @ne :=  FEventList.Items[i];
      ne(FListenObject);

@ne - это не event а ссылка на проседуру

--------------------

Кольцов Виктор Владимирович

MetalFan

Дата 3.7.2009, 11:06 (ссылка)

(нет голосов)

Загрузка ...

Аццкий Сотона

Профиль
Группа: Комодератор
Сообщений: 3815
Регистрация: 2.10.2006
Где: Moscow

Репутация: 62
Всего: 128

Frees, не на процедуру, а на ЗАПИСЬ (из двух указателей, на класс и на код метода), описывающую метод класса. это несколько разные вещи. если потестишь с пристрастием, то наверняка вылезут глюки)
я в свое время писал нечто такое:
1. базовый класс - список методов.

Код


  //NotifyList
  PMethod = ^TMethod;
  TMethodList = class( TList )
  private
    function GetMethod(AIndex: Integer): TMethod;
  protected

    function AddMethod( AMethod: TMethod ): Integer;
    function RemoveMethod( AMethod: TMethod ): Boolean;
    function IndexOfMethod( AMethod: TMethod ): Integer;
    procedure Notify(Ptr: Pointer; Action: TListNotification); override;
    property Methods[ AIndex: Integer ]: TMethod read GetMethod;
    procedure NotifyMethod( AMethod: TMethod ); virtual; abstract;
  public
    procedure NotifyList;
  end;

implementation

{ TNotifyList }

function TMethodList.AddMethod(AMethod: TMethod): Integer;
var
  lMethod: PMethod;
begin
  new( lMethod );
  System.Move( AMethod, lMethod^, SizeOf( TMethod ));
  Result := Add(lMethod);
end;

function TMethodList.GetMethod(AIndex: Integer): TMethod;
begin
  System.Move( Items[AIndex]^, Result, SizeOf(TMethod));
end;

function TMethodList.IndexOfMethod(AMethod: TMethod): Integer;
begin
  for Result := 0 to pred( Count ) do
    if CompareMem(Items[Result], @AMethod, SizeOf( TMethod ) ) then Exit;
  Result := -1;
end;

procedure TMethodList.Notify(Ptr: Pointer; Action: TListNotification);
begin
  case Action of
    lnDeleted: Dispose( PMethod( Ptr )); 
  end;

end;

procedure TMethodList.NotifyList;
var
  i: Integer;
begin
  for i := 0 to pred( Count ) do
    NotifyMethod( Methods[i] );
end;

function TMethodList.RemoveMethod(AMethod: TMethod): Boolean;
var
  lIdx: Integer;
begin
  Result := False;
  lIdx := IndexOfMethod( AMethod );
  if lIdx = -1 then Exit;
  Delete( lIdx );
  Result := True;
end;

2. и пример наследника - списка нотификации о смене активной формы приложения.

Код


  TActiveFormChangeNotifyList = Class( TMethodList )
  protected
    FSender: TObject;
    procedure NotifyMethod(AMethod: TMethod); override;
    procedure OnActiveFormChange( Sender: TObject );
  public
    constructor Create;
    destructor Destroy; override;
    
    procedure AddHandler( ANotify: TNotifyEvent );
    procedure RemoveHandler( ANotify: TNotifyEvent );
  end;

implementation

{ TActiveFormChangeNotifyList }

procedure TActiveFormChangeNotifyList.AddHandler(ANotify: TNotifyEvent);
begin
  AddMethod( TMethod( ANotify ) )
end;

constructor TActiveFormChangeNotifyList.Create;
begin
  Screen.OnActiveFormChange := OnActiveFormChange;
end;

destructor TActiveFormChangeNotifyList.Destroy;
begin
  Screen.OnActiveFormChange := nil;
  inherited;
end;

procedure TActiveFormChangeNotifyList.NotifyMethod(AMethod: TMethod);
begin
  TNotifyEvent( AMethod )( FSender );
end;

procedure TActiveFormChangeNotifyList.OnActiveFormChange(Sender: TObject);
begin
  if Screen.ActiveForm = nil then Exit;
  FSender := Sender;
  NotifyList;
end;

procedure TActiveFormChangeNotifyList.RemoveHandler(ANotify: TNotifyEvent);
begin
  RemoveMethod( TMethod( ANotify ) )
end;

можно конечно без базового класса, но у мне надо было в нескольких местах несколько разных типов методов обрабатывать.

код 99,9% рабочий, ибо взят из реального проекта.

--------------------

There are always someone smarter than you...

Frees

Дата 3.7.2009, 12:29 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Завсегдатай
Сообщений: 2233
Регистрация: 2.12.2005
Где: Екатеринбург

Репутация: 9
Всего: 54

Цитата(MetalFan @ 3.7.2009, 14:06

)

если потестишь с пристрастием, то наверняка вылезут глюки)

глюк не нашел

Цитата(MetalFan @ 3.7.2009, 14:06

)

а на ЗАПИСЬ (из двух указателей, на класс и на код метода)

чет не то ели бы было так как ты говориш то мой код бы не работал

в OnClick храниться ссылка на процедуру

Код


TNotifyEvent = procedure(Sender: TObject) of object;

где тут запись?

--------------------

Кольцов Виктор Владимирович

MetalFan

Дата 3.7.2009, 14:33 (ссылка)

(нет голосов)

Загрузка ...

Аццкий Сотона

Профиль
Группа: Комодератор
Сообщений: 3815
Регистрация: 2.10.2006
Где: Moscow

Репутация: 62
Всего: 128

Цитата(Frees @ 3.7.2009, 12:29

)

чет не то ели бы было так как ты говориш то мой код бы не работал

в OnClick храниться ссылка на процедуру

твой код работает в данном простом случае и примитивном приложении.
но если ты не делаешь разницы между процедурой и методом объекта, то дальнейший спор считаю бессмысленным.

Добавлено через 8 минут и 28 секунд
хотя я может что-то путаю smile

но у меня возникали проблемы с хранением просто указателя на TMethod...

--------------------

There are always someone smarter than you...

Frees

Дата 3.7.2009, 15:07 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Завсегдатай
Сообщений: 2233
Регистрация: 2.12.2005
Где: Екатеринбург

Репутация: 9
Всего: 54

Цитата(MetalFan @ 3.7.2009, 17:33

)

между процедурой и методом объекта

я сохранял не метод а процедуру smile

--------------------

Кольцов Виктор Владимирович

MetalFan

Дата 3.7.2009, 17:17 (ссылка)

(нет голосов)

Загрузка ...

Аццкий Сотона

Профиль
Группа: Комодератор
Сообщений: 3815
Регистрация: 2.10.2006
Где: Moscow

Репутация: 62
Всего: 128

Цитата(Frees @ 3.7.2009, 07:35

)

procedure TEvents.OnEvent(Sender: TObject);
var
  I: Integer;
  ne: TNotifyEvent;
begin
  for I := 0 to FEventList.Count - 1 do
    if Assigned(FEventList.Items[i]) then
    begin
      @ne :=  FEventList.Items[i];
      ne(FListenObject);
    end;
end;

ne в данном случае содержит информацию о методе объекта. а не только указатель на процедуру.

Это сообщение отредактировал(а) MetalFan - 3.7.2009, 17:17

--------------------

There are always someone smarter than you...

SpaceIQ

Дата 4.7.2009, 15:19 (ссылка)

(нет голосов)

Загрузка ...

Новичок

Профиль
Группа: Участник
Сообщений: 11
Регистрация: 2.7.2009

Репутация: нет
Всего: нет

Rennigth, MetalFan, Frees спасибо большое! В ваших сообщениях я нашел все что мне было нужно!

0 Пользователей читают эту тему (0 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема \| Delphi: Общие вопросы \| Следующая тема »