Foros Club Delphi - Problema con borrado de componentes creados en tiempo de ejecución

Foros Club Delphi (https://www.clubdelphi.com/foros/index.php)

- OOP (https://www.clubdelphi.com/foros/forumdisplay.php?f=5)

- - Problema con borrado de componentes creados en tiempo de ejecución (https://www.clubdelphi.com/foros/showthread.php?t=51626)

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

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

Código:



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 ;)

Código:

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

Código:

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

Ops :rolleyes: 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.

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

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

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.

;)