[harpo]

Ese parámetro que le pasas, es un puntero nulo, además no se usa para nada en la rutina AddStudy.

Ops cierto.

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.

 Por cierto, el Controller lo bajaste de algún sitio, lo construiste tú ??

Cosecha de la casa. 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.