Problema con borrado de componentes creados en tiempo de ejecución

[harpo]

Buenas,
Estoy tratando de hacer una aplicación en la que necesito crear y eliminar frames en tiempo de ejecución.

procedure TfrViewPatient.frEnter;
begin
  studyList:=TObjectList.Create;
end;

procedure TfrViewPatient.frExit;
begin
  studyList.Free;    
end;

procedure TfrViewPatient.AddStudy(study:TStudy);
var
  studyFrame: TfrStudy;
begin
  try
    studyFrame:=TfrStudy.Create(self);
    studyFrame.Parent:= ScrollBox;
    studyFrame.Name:='frStudy'+IntToStr(studyList.Count+1);
    studyFrame.IO.LoadFromFile('Images\1\1\000006.jpg');
    studyFrame.PanelStudy.OnClick:=FrStudyOnClick;
    Controller.RegisterListener(MSG_STUDY_CLICK,StudyClick);
    studyList.Add(studyFrame);

  except
    ShowMessage('Error creating study');
    Exit;
  end;
end;

procedure TfrViewPatient.StudyClick(Sender:TObject);
begin
  //todo: enter stViewStudy
  states.Enter(stViewStudy);  <-- aquí el error
end;

procedure TfrViewPatient.FrStudyOnClick(Sender:TObject);
begin
  Controller.Send(TMessage.Create(MSG_STUDY_CLICK,self,false));
end;

//todo: eliminar...
procedure TfrViewPatient.BitBtn1Click(Sender: TObject);
var
  study: TStudy;
begin
  AddStudy(study);  
end;

end.

La parte de Controller.RegisterListener(MSG_STUDY_CLICK,StudyClick); es irrelevante. Utilizo un controlador de eventos para lanzarlos en otros threats. Igualmente, utilizo una máquina de estados para controlar las vistas, de ahí el states.Enter(stViewStudy);, que lo que hace básicamente es llamar al procedimiento frExit, donde hago el free de studyList, y modificar algunos aspectos visuales.

El tema está en que si añado un frame TfrStudy (AddStudy(study)) y lo añado a la lista studyList:TobjectList, al cambiar de frame (eliminando por tanto la lista studyList), me salta un error EOSError System Error code 5. Si
no creo ningún frame y por tanto no elimino, no hay problemas.

Alguna idea ??

Gracias

[[Lepe]]

 AddStudy(study);

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

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.

En fin, que es muy complejo, y con poca información poco se puede hacer. Yo al menos, no liberaría la lista hasta destruir el TfrViewPatient, porque quizás reciba mensajes del Controller (pero ya estoy adivinando cómo lo tienes implementado).

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

Saludos

[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.

[[Lepe]]

Gracias por poner el código del Controller, tenía curiosidad y veo que tienes una implementación parecida a la mía (con cola de mensajes jeje).

Al final con mis divagaciones no sé si sigues teniendo problemas, pero ya nos contarás.

Saludos

[harpo]

Pues no lo he solucionado aun. Me temo que el problema está en el uso del controlador. No puedo lanzar funciones de la API desde otro threat q no sea el principal ¬¬...
estoy en ello

[jachguate]

No he leido todo el código. Quizás el problema esté en la VCL (si haces uso de ella), pues esta no soporta multithreading. Forzosamente hay que sincronizar con el hilo principal de la aplicación.

Hasta luego.