Código:
Ese parámetro que le pasas, es un puntero nulo, además no se usa para nada en la rutina AddStudy.
Ops
cierto.
Código:
El "controlador de eventos" (patrón del observador que lo llamaría yo) tendrá mucho que ver, dado que le estas pasando el parámetro "Self", o sea el TfrViewPatient, que a saber en qué situación se encuentra tu StudyList cuando reciba un mensaje.
Ya me dí cuenta, lanzando el evento desde el OnClick del panel del frame en lugar de enviando el mensaje al controlador no hay fallo.
Código:
Por cierto, el Controller lo bajaste de algún sitio, lo construiste tú ??
Cosecha de la casa. Código:
Código:
unit UController;
interface
uses
Classes, SyncObjs;
type
TMessageTypeID = string [64];
TNotifyProc = procedure(payload :TObject) of object;
TListenerEntry = class(TObject)
public
msgTypeID :TMessageTypeID;
notifyProc :TNotifyProc;
constructor Create(msgTypeID: TMessageTypeID; notifyProc :TNotifyProc);
end;
TListenerList = class(TThreadList)
private
function Get(i: integer):TListenerEntry;
public
function Count :Integer;
destructor Destroy; override;
procedure Add(msgTypeId :TMessageTypeID; notifyProc :TNotifyProc);
property Listeners[Index: Integer]: TListenerEntry read Get; default;
end;
TMessage = class (TObject)
private
freePayload :Boolean;
public
TypeID : TMessageTypeID;
Payload :TObject;
constructor Create(msgTypeID :TMessageTypeID; payload :TObject;freePayload : boolean = false);
destructor Destroy(); override;
end;
TMessageQueue = class (TThreadList)
public
function Add(msg: TMessage): boolean;
function GetNext :TMessage;
end;
TController = class(TThread)
public
function Send(msg: TMessage): TMessage;
procedure RegisterListener(msgTypeId :TMessageTypeID; notifyProc :TNotifyProc);
constructor Create;
destructor Destroy; override;
procedure Execute; override;
procedure ProcessNext;
private
QueueEvent :Tevent;
Listeners :TListenerList;
MessageQueue :TMessageQueue;
end;
var
Controller :TController;
implementation
constructor TListenerEntry.Create(msgTypeID: TMessageTypeID; notifyProc :TNotifyProc);
begin
self.msgTypeID := msgTypeID;
self.notifyProc := notifyProc;
end;
destructor TListenerList.Destroy;
begin
inherited Destroy();
end;
function TListenerList.Get(i: integer):TListenerEntry;
begin
try
result := LockList.Items[i];
finally
UnlockList;
end;
end;
function TListenerList.Count : integer;
begin
try
result := LockList.Count;
finally
UnlockList;
end;
end;
procedure TListenerList.Add(msgTypeId :TMessageTypeID; notifyProc :TNotifyProc);
var
newEntry:TListenerEntry;
begin
newEntry := TListenerEntry.Create(msgTypeId,notifyProc);
inherited Add(newEntry);
end;
constructor TMessage.Create(msgTypeID :TMessageTypeID; payload :TObject; freePayload : boolean = false);
begin
self.Payload := payload;
self.TypeID := msgTypeID;
self.freePayload := freePayload;
end;
destructor TMessage.Destroy();
begin
if freePayload then Payload.Free;
inherited Destroy;
end;
function TMessageQueue.GetNext :TMessage;
begin
try
with inherited LockList do
begin
if (count > 0) then
begin
result := Items[count -1];
Delete(count-1);
end
else result := nil
end;
finally
UnlockList;
end;
end;
function TMessageQueue.Add(msg: TMessage) :boolean;
begin
try
result := inherited LockList.add(msg) >= 0;
finally
UnlockList;
end;
end;
{ =============== TController Implementation ==================== }
constructor TController.Create;
begin
inherited Create(false);
Priority := tpNormal;
QueueEvent := TEvent.Create(nil,true,false,'Q');
QueueEvent.ResetEvent;
MessageQueue := TMessageQueue.Create;
Listeners := TListenerList.Create;
//start
end;
destructor TController.Destroy();
begin
Terminate;
MessageQueue.Free;
Listeners.Free;
QueueEvent.Free;
inherited Destroy();
end;
procedure TController.RegisterListener(msgTypeId :TMessageTypeID; notifyProc :TNotifyProc);
begin
Listeners.Add(msgTypeId,notifyProc);
end;
function TController.Send(msg: TMessage) :TMessage;
begin
MessageQueue.Add(msg);
result := msg;
QueueEvent.SetEvent;
end;
procedure TController.Execute;
begin
while not Terminated do
begin
if QueueEvent.WaitFor(1000) = wrSignaled then
begin
if not Terminated then begin
ProcessNext;
end;
end;
end;
end;
procedure TController.ProcessNext;
var
i:Integer;
msg :TMessage;
begin
msg := MessageQueue.GetNext;
if msg <> nil then for i := 0 to Listeners.count -1 do
begin
if msg.TypeID = Listeners[i].msgTypeID then
begin
Listeners[i].notifyProc(msg.Payload);
msg.Free;
end;
end else QueueEvent.ResetEvent;
end;
initialization
Controller := TController.Create;
finalization
Controller.Free;
end.
Gracias por tu respuesta.