Текущий архив: 2008.04.27;
Скачать: CL | DM;

Вниз

var vs class var   Найти похожие ветки 

← →
Pir   (2008-03-18 05:52) [0]

Сори, что пишу сюда, но тут есть шанс, что ответят по-быстрому...

Вопрос такой: пишу класс на дельфях, в нем должна быть одна переменная типа TEvent = procedure (Sender: TBaseObject; Param: Cardinal). Запихиваю ее в private с именем fUniversal и делаю к ней property. Но при работе программы что-то происходит в этом классе и значение Addr(fUniversal) постоянно равно то адресу процедуры, то нулю. При этом если вызывать ее без проверки, она выдает AV. Но все работает, если fUniversal задать как class var. Но нужна не общая переменная. Не подскажете, как быть?

Вот юнит с этим классом:
unit EventManager;

interface

uses BaseObject, Variants;

type
 TEvent = procedure (Sender: TBaseObject; Param: Cardinal);

 TEventProperty = record
   Name: String;
   Event: TEvent;

   Param: Cardinal;

   procedure Call(const Sender: TBaseObject = nil);
 end;

 TEventManager = class(TBaseObject)
 private
   fEvents: Array of TEventProperty;
   fCaseSensetive: Boolean;
   fAutoClean: Boolean;

   class var fUniversal: TEvent;
 protected
   function GetEventIndexByName(Name: String): Integer;
   function GetEventByName(const Name: String): TEvent;
   function GetEventByIndex(const Index: Cardinal): TEvent;
   procedure AddEvent(const Name: String; const Event: TEvent);
   procedure SetEventValueByName(const Name: String; const Event: TEvent);
   procedure SetEventValueByIndex(const Index: Cardinal; const Event: TEvent);
   function GetUniversal: TEvent;
   procedure SetUniversal(const Event: TEvent);
 public
   property Events[const Name: String]: TEvent read GetEventByName write SetEventValueByName; default;
   property Events[const Index: Cardinal]: TEvent read GetEventByIndex write SetEventValueByIndex; default;

   property Universal: TEvent read GetUniversal write SetUniversal;

   procedure Init(const Name: String; const Parent: TBaseObject); override;
   procedure DeInit; override;

   procedure Process; override;

   procedure Clear;

   procedure Clean;

   procedure Call(const Name: String; const Sender: TBaseObject = nil; const Param: Cardinal = 0);

   function Count: Integer;
 published
   property CaseSensetive: Boolean read fCaseSensetive write fCaseSensetive;
   property AutoClean: Boolean read fAutoClean write fAutoClean;
 end;

function CreateEventManager(const Name: String = ""; const Parent: TBaseObject = nil): TEventManager;

implementation

uses SysUtils;

procedure TEventProperty.Call(const Sender: TBaseObject = nil);
begin
 if @Event <> nil then
   Event(Sender, Param);
end;

procedure TEventManager.Init;
begin
 inherited;

 Clear;

 fCaseSensetive := False;
 fAutoClean := True;
 fUniversal := nil;
end;

procedure TEventManager.DeInit;
begin
 Clear;

 inherited;
end;

procedure TEventManager.Process;
begin
 if fAutoClean then
   Clean;
end;

procedure TEventManager.Clear;
begin
 SetLength(fEvents, 0);
end;

function TEventManager.GetEventIndexByName(Name: String): Integer;
var
 i: Integer;
 PropName: String;
begin
 Result := -1;

 if Length(fEvents) = 0 then Exit;

 Name := Trim(Name);
 if not fCaseSensetive then Name := LowerCase(Name);

 for i := 0 to Length(fEvents) - 1 do begin
   PropName := Trim(fEvents[i].Name);

   if not fCaseSensetive then PropName := LowerCase(PropName);

   if Name = PropName then begin
     Result := i;
     Exit;
   end;
 end;
end;

function TEventManager.GetEventByName(const Name: String): TEvent;
var
 Index: Integer;
begin
 Result := nil;

 Index := GetEventIndexByName(Name);

 if Index >= 0 then begin
   Result := fEvents[Index].Event;
 end;
end;

function TEventManager.GetEventByIndex(const Index: Cardinal): TEvent;
begin
 Result := nil;

 if (Index < 0) or (Index >= Length(fEvents)) then Exit;

 Result := fEvents[Index].Event;
end;

procedure TEventManager.AddEvent(const Name: String; const Event: TEvent);
begin
 SetLength(fEvents, Length(fEvents) + 1);
 fEvents[Length(fEvents) - 1].Name := Name;
 fEvents[Length(fEvents) - 1].Event := Event;
end;

procedure TEventManager.SetEventValueByName(const Name: String; const Event: TEvent);
var
 Index: Integer;
begin
 Index := GetEventIndexByName(Name);

 if Index < 0 then begin
   AddEvent(Name, Event);
 end else begin
   fEvents[Index].Name := Name;
   fEvents[Index].Event := Event;
 end;
end;

procedure TEventManager.SetEventValueByIndex(const Index: Cardinal; const Event: TEvent);
var
 OldCount: Integer;
 i: Integer;
begin
 if Index < 0 then Exit;

 if Index >= Length(fEvents) then begin
   OldCount := Length(fEvents);
   SetLength(fEvents, Index - 1);
   for i := OldCount - 1 to Length(fEvents) - 1 do begin
     fEvents[i].Name := "";
     fEvents[i].Event := nil;
   end;
 end;
 fEvents[Index].Event := Event;
end;

function TEventManager.GetUniversal: TEvent;
begin
 Result := fUniversal;
end;

procedure TEventManager.SetUniversal(const Event: TEvent);
begin
 fUniversal := Event;
end;

procedure TEventManager.Clean;
var
 i: Integer;
 Name: String;
begin
 if Length(fEvents) = 0 then Exit;

 i := 0;
 while i < Length(fEvents) do begin
   Name := Trim(fEvents[i].Name);
   if (Name = "") or
      (not Assigned(fEvents[i].Event)) then begin
     if i < Length(fEvents) - 1 then
       fEvents[i] := fEvents[Length(fEvents) - 1];
     SetLength(fEvents, Length(fEvents) - 1);
     Continue;
   end;
   Inc(i);
 end;
end;

procedure TEventManager.Call(const Name: String; const Sender: TBaseObject = nil; const Param: Cardinal = 0);
var
 Index: Integer;
begin
 Index := GetEventIndexByName(Name);

 if Index >= 0 then begin
   if Addr(fUniversal) <> nil then begin
     fUniversal(Sender, Param);
   end;
   if Addr(fEvents[Index].Event) <> nil then begin
     fEvents[Index].Param := Param;
     fEvents[Index].Call(Sender);
   end;
 end;
end;

function TEventManager.Count: Integer;
begin
 Result := Length(fEvents);
end;

function CreateEventManager(const Name: String = ""; const Parent: TBaseObject = nil): TEventManager;
begin
 Result := TEventManager.Create(Name, Parent);
end;

end.

Писалось на турбо делфи.

---

← →
MBo ©   (2008-03-18 06:12) [1]

TEvent = procedure (Sender: TBaseObject; Param: Cardinal) of object

P.S. обычно геттеры для процедурных свойств (GetUniversal) не делают, можно обойтись fUniversal

---

← →
Pir   (2008-03-18 06:16) [2]

Нет, of object не надо, используются процедуры вне классов. А геттер используется для того, чтобы обращаться к class var, находящейся в секции private.

---

← →
Pir   (2008-03-18 06:18) [3]

Исходники (правда, немного староватая версия, но ошибка та же) тут: http://osvldm.narod.ru/Again.rar

---

← →
Ega23 ©   (2008-03-18 06:25) [4]

> А геттер используется для того, чтобы обращаться к class
> var, находящейся в секции private.


Вот этой фразы вообще не понял.
Это что по-твоему, я не смогу поле в private-секции без Get прочитать???

---

← →
Pir   (2008-03-18 06:29) [5]

А фиг его знает... Конструкция вида property Universal: TEvent read fUniversal write fUniversal в случае с class var не срабатывает у меня. А если сделать так, то явно не прокатит:

var
 EM: TEventManager;
begin
 EM := TEventManager.Create;
 EM.fUniversal := nil;
 EM.Free;
end;


---

← →
MBo ©   (2008-03-18 06:44) [6]

Universal: TEvent read fUniversal write SetUniversal;

---

← →
icWasya ©   (2008-03-18 10:09) [7]

В исходниках Delphi обычно проверяют Assigned(fUniversal)

---

← →
Ega23 ©   (2008-03-18 10:31) [8]

> В исходниках Delphi обычно проверяют Assigned(fUniversal)


Потому что если попробуют поставить fUniversal =nil, то сначала выполнится fUniversal (это же процедура как-никак)...

---

← →
Pir   (2008-03-18 15:41) [9]

Самый прикол в том, что даже если тип поменять с TEvent на PEvent = ^TEvent и заменить соотв. обращения, все равно не работает. Но если fUniversal объявить как class var - как швейцарские часы.

---

← →
Ega23 ©   (2008-03-18 16:45) [10]

Я вот одного не могу понять: нафига такие сложности? Ну объяви свой TEvent как procedure of object, и не парься...

---

Страницы: 1 вся ветка

Текущий архив: 2008.04.27;
Скачать: CL | DM;

Наверх

Память: 0.5 MB
Время: 0.015 c