FTP | CCD | Buscar | Trucos | Trabajo | Foros |
|
Registrarse | FAQ | Miembros | Calendario | Guía de estilo | Temas de Hoy |
|
Herramientas | Buscar en Tema | Desplegado |
#1
|
|||
|
|||
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. 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 |
#2
|
||||
|
||||
Código:
AddStudy(study); 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
__________________
Si usted entendió mi comentario, contácteme y gustosamente, se lo volveré a explicar hasta que no lo entienda, Gracias. |
#3
|
|||
|
|||
Código:
Ese parámetro que le pasas, es un puntero nulo, además no se usa para nada en la rutina AddStudy. 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. Código:
Por cierto, el Controller lo bajaste de algún sitio, lo construiste tú ?? 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. |
#4
|
||||
|
||||
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
__________________
Si usted entendió mi comentario, contácteme y gustosamente, se lo volveré a explicar hasta que no lo entienda, Gracias. |
#5
|
|||
|
|||
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 |
#6
|
||||
|
||||
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.
__________________
Juan Antonio Castillo Hernández (jachguate) Guía de Estilo | Etiqueta CODE | Búsca antes de preguntar | blog de jachguate |
|
|
Temas Similares | ||||
Tema | Autor | Foro | Respuestas | Último mensaje |
Borrar los Datasource Creados en tiempo de ejecucion | Nieto | OOP | 2 | 29-11-2007 22:12:19 |
cambiar tamaño y mover componentes creados en tiempo de ejecucion | gulder | API de Windows | 4 | 18-11-2006 23:21:16 |
Destruir Qrlabels creados en tiempo de ejecucion | Ade | Impresión | 6 | 08-10-2006 19:46:28 |
Eventos en componentes creados en tiempo de ejecucion | joumont | OOP | 3 | 27-12-2005 14:48:23 |
Objetos creados en tiempo de ejecución | Scocc | OOP | 4 | 13-06-2003 20:55:29 |
|