Out of Memory

[javicho_villa]

Buenos días amigos del foro quiero pedirles su ayuda en un problema que no veo la solución por ningón lado, Tengo una aplicación que estoy desarrollando para Presupuestos, uso SQL y a nivel de tablas tengo tres tablas principales: Prespuesto(Maestro), PresupuestoDetalle(Detalle)y 6 tablas mas que son el detalle de esta tabla, como PresupuestoDetalleCosto, PresupuestoDetalleTalla,.....etc.

en la pantalla que visualizo los datos PresupuestoDetalle, muestro un campo imagen de esta tabla, y al comienzo funcionó bien pero luego al ingresar 5 o 6 registros mas me sale el mensaje de OUT OF MEMOY, para esto quiero decir que hay un Grid de la clase TsGrid conectada con TDataSource en donde muestro esta imagen, que a pesar que la estoy comentando, sigue apareciendo el error.

Active el ReportMemoryLeaksOnShutDown := True; y me mostró los siguientes mensajes:

https://www.clubdelphi.com/foros/att...1&d=1559585692
https://www.clubdelphi.com/foros/att...1&d=1559585692

Les paso el codigo de ese formulario:

Código Delphi [-]
procedure TPresupuestoDatoForm.Filtrar;
var Cad,Fil:String;
begin
  Fil := '';
  if length(Id_PresupuestoEdit.Text)>0 then
    Fil := ' where (Id_Presupuesto='+Id_PresupuestoEdit.Text+') and (eliminado=0)';

//  Cad := 'select P.NombreProducto, PT.Nombre as '+QuotedStr('TipoPT')+
//  ', G.Nombre as '+QUotedStr('Genero')+', M.Nombre as '+QuotedStr('Modelo')+
//  ', P.Id_Parametro_TipoGenero, P.Id_Parametro_TipoPT, P.Id_Parametro_Modelo, D.*,'+
//  ' P.CNN from DetallePresupuesto D '+
//  ' left join Producto  P  on D.Id_Producto         = P.Id_Producto '+
//  ' left join Parametro PT on P.Id_Parametro_TipoPT = PT.Id_Parametro '+
//  ' left join Parametro G  on P.Id_Parametro_Genero = G.Id_Parametro '+
//  ' left join Parametro M  on P.Id_Parametro_Modelo = M.Id_Parametro '+Fil;

  Cad := 'select Id_DetallePresupuesto, versionactual, po, sc, estilo, Imagen from DetallePresupuesto '+Fil;

  try
    Conexion.Dm.DetalleADOQuery.SQL.Clear;
    Conexion.Dm.DetalleADOQuery.SQL.Add(Cad);
    Conexion.Dm.DetalleADOQuery.Active := true;
    Conexion.Dm.DetalleADOQuery.Last;
  finally
    //
  end;

  with TStringGrid(Lista) do
    begin
      DefaultRowHeight := 90; // alto de filas a gusto
      RowHeights[0]    := 25;  // alto de título
    end;

end;

Les paso el codigo del evento del DrawColumnCell

Código Delphi [-]
procedure TPresupuestoDatoForm.ListaDrawColumnCell(Sender: TObject;
  const Rect: TRect; DataCol: Integer; Column: TColumn; State: TGridDrawState);
var wic: TWICImage;
    Stream:TMemoryStream;
    //R:TRect; longitud, selecc: integer;
    DrawState: Integer;
    DrawRect: TRect;
begin
  if Dm.DetalleADOQuery.RecordCount>0 then
    if ( Column.FieldName = 'Imagen' ) then
      begin
        Stream := TMemoryStream.Create;
        TGraphicField(Dm.DetalleADOQuery.FieldByName('Imagen')).SaveToStream(Stream);
        Stream.Position := 0;
        wic := TWICImage.Create;
        wic.LoadFromStream(Stream);
        with TPicture.Create do
        try
          //Assign( Column.Field );
          Assign(wic);
          //Lista.Canvas.StretchDraw( Rect, BitMap );
          Lista.Canvas.StretchDraw(Rect, wic);
        finally
          Free;
        end;
      end;
end;

Este código lo he comentado para probar, mejoro un poquito pero igual sigue saliendo el Out of Memory

Por ultimo el componente TsGrid es un componente que compre de los AlphaControls, no he tenido ningún problema con este componente en otros formularios que los he utilizado.

De Antemano muchas gracias por toda la atención prestada y ojala me puedan ayudar.

Javier Villa.

[ecfisa]

Hola.

Te sugiero subir otras imágenes las actuales son muy pequeñas y no se puede apreciar el texto.

Por otro lado, el error quizá se produzca cuando muestras la imágen en el evento OnDrawColumCell, ya que cada vez que se ejecuta crea una instancia de la clase TMemoryStream ( Stream ) y no la estas liberando.

Intenta de este modo:

Código Delphi [-]
procedure TPresupuestoDatoForm.ListaDrawColumnCell(Sender: TObject;
  const Rect: TRect; DataCol: Integer; Column: TColumn; State: TGridDrawState);
begin
  ...
    if ( Column.FieldName = 'Imagen' ) then
    begin
      Stream := TMemoryStream.Create;
      try
        TGraphicField(Dm.DetalleADOQuery.FieldByName('Imagen')).SaveToStream(Stream);
        ...
        ...
      finally
        Stream.Free;
      end;
    end;
  ...
end;

Saludos

[javicho_villa]

Muchas gracias por la pronta respuesta. libere esos objetos y mejoró

Código Delphi [-]
procedure TPresupuestoDatoForm.ListaDrawColumnCell(Sender: TObject;
  const Rect: TRect; DataCol: Integer; Column: TColumn; State: TGridDrawState);
var wic: TWICImage;
    Stream:TMemoryStream;
    DrawState: Integer;
    DrawRect: TRect;
begin
  if Dm.DetalleADOQuery.RecordCount>0 then
    if ( Column.FieldName = 'Imagen' ) then
      begin
        Stream := TMemoryStream.Create;
        TGraphicField(Dm.DetalleADOQuery.FieldByName('Imagen')).SaveToStream(Stream);
        Stream.Position := 0;
        wic := TWICImage.Create;
        wic.LoadFromStream(Stream);
        with TPicture.Create do
        try
          //Assign( Column.Field );
          Assign(wic);
          //Lista.Canvas.StretchDraw( Rect, BitMap );
          Lista.Canvas.StretchDraw(Rect, wic);
        finally
          wic.free;
          Stream.free;
          Free;
          ////DrawRect.free;
        end;
      end;
end;

aun sale el out of memory, te paso la imagen del nuevo mensaje.

https://www.clubdelphi.com/foros/att...1&d=1559596362

Muchas gracias por el apoyo.

[javicho_villa]

Alguien de generoso corazón que me pueda ayudar con este mensaje que no puedo dar con la solución por favor.
de antemano muchas gracias por la atención.

[Casimiro Notevi]

¿En qué línea ocurre?

[[gatosoft]]

Hace poco tuve un error parecido y tenia que ver con el tamaño de la consulta que hacia el Query... eran mas de 800 mil registros que retornaba y tambien tenia un OnDrawColumnCell Pesado... y la tabla fisica tenia mas de 3 millones de registros...


No fallaba al momento de hacer el open, sino cuando intentaba recorrer y recuperar registros... una de las lineas en las que fallaba, era al intentar pasar esta data a otro dataset a traves de XMLData (propiedad del TClientDataset)...

La solución estuvo en aplicar filtros a dicha consulta. igual se demoraba un poco en recuperar datos, pero no explotaba por memoria.


Esposible que en tu caso el problema pueda ser por el numero de registros recuperados, a lo que debes sumar la cantidad de Imagenes que creas por cada registro, lo cual puede consumir tu memoria.´

Intenta hacer la consulta sin crear esas imagenes... es decir comenta el código del evento y revisa si te sigue saliendo el porblema... (solo por descartar que no sea otra cosa)

[javicho_villa]

Muchas gracias por las respuestas, les quiero comentar que muestro en un grid una imagen por cada registro, también utilizo vrias clases que cree como Tprespuesto, Tproducto, Tparametro, TdetallePresupuesto (esto lo utilizo con TObjectList para jalar el detalle), el tema es que son solo 5 registros de detalle no es mucha data, pero cuando utilizo ReportMemoryLeaksOnShutDown, me sale varios objetos perdidos Tparametro, TPresupuest, etc, que he revisado y creo que los estoy liberando de memeoria bien.

Tambien quiero comentar que a veces una objeto se queda referenciado con otro objeto y solo a traves de invocar nuevamente el eevento create se desvinclua, por eso que cada vez que quiero liberar un objeto, primero invoco el create y luego el free, ejemplo

Código Delphi [-]

iPresupuesto := TPresupuesto.create;
....
....
MiListaPresupuesto.add(iPresupuesto);
....
....
iPresupuesto := TPresupuesto.create;
iPresupuesto.Free;

Quizás este el error por ahí.

Otra consulta es que utilizo un objecto de la clase TWICImage;
este objeto me permite trabajar con imágenes de varias extensiones pero no se como medir si me consume recurso de la pc.

De antemano muchas gracias por todas las respuestas.

[javicho_villa]

Una cosita mas, en el mensaje del reporte ReportMemoryLeaksOnShutDown como perdida de memoria, sale el tipo UnicodeString varias veces y nose como liberar eso de memoria, como se interpreta estos mensajes:

13-20 bytes: UnicodeString x 7
21-28 bytes: TMemoryStream x 14, UnicodeString x 3
29-36 bytes: UnicodeString x 3
37-44 bytes: UnicodeString x 3
45-52 bytes: UnicodeString x 1
53-60 bytes: UnicodeString x 1
61-68 bytes: TParametro x 6,
29-36 bytes: UnicodeString x 3 Tpresupuesto x 2
93-100 bytes: UnicodeString x 1
101-108 bytes: UnicodeString x 1
117-124 bytes:TCiente x 4

Gracias a todos por la atención.

[javicho_villa]

Buenas con todos,

Quiero comentarles que de a pocos he ido depurando mi código y he logrado disminuir las perdidas de memoria, he detectado que cuando invoco este procedimiento:
me genera una perdida de memoria, que hasta ahora no puedo saber porque: les paso el procedimiento y el mensaje y el código de las clases involucradas también

esta clase es como una capa donde me conecto con la base de datos: SQL

Código Delphi [-]
function TCx_Presupuesto.GetPresupuesto(Id: integer): TPresupuesto;
var MiQuery: TAdoQuery;
    iPresupuesto:TPresupuesto;
    Cad:String;
    ConCli:TCx_Cliente;
begin
  try
    iPresupuesto := TPresupuesto.Create;
    MiQuery  := TAdoQuery.Create(nil);
    MiQuery.SQL.Clear;
    MiQuery.Connection := Conexion.Dm.PrincipalADOConnection;
    MiQuery.SQL.Clear;
    Cad := 'select * from Presupuesto where Id_Presupuesto='+IntToStr(Id) ;
    MiQuery.SQL.Add(Cad);
    MiQuery.Active := true;
    if MiQuery.RecordCount>0 then
      begin
        MiQuery.First;
        iPresupuesto.iId_Presupuesto   := MiQuery.FieldByName('Id_Presupuesto').AsInteger;
        iPresupuesto.iId_Cliente       := MiQuery.FieldByName('Id_Cliente').AsInteger;
        iPresupuesto.iFEmision         := VarToDateTime(MiQuery.FieldByName('FEmision').AsVariant);
        if iPresupuesto.iFfin <> 0.0 then
          iPresupuesto.iFfin           := VarToDateTime(MiQuery.FieldByName('Ffin').AsVariant);
        iPresupuesto.iCerrado          := MiQuery.FieldByName('Cerrado').AsBoolean;
        iPresupuesto.iObservaciones    := MiQuery.FieldByName('Observaciones').AsString;
        iPresupuesto.iId_Usuario       := MiQuery.FieldByName('Id_Usuario').AsInteger;
        iPresupuesto.iFRegistro        := VarToDateTime(MiQuery.FieldByName('FRegistro').AsVariant);
        try
          ConCli := TCx_Cliente.Create;
          iPresupuesto.iCliente          := ConCli.GetCliente(iPresupuesto.iId_Cliente);
        finally
          FreeAndNil(ConCli);
        end;
      end;
  finally
    FreeAndNil(MiQuery);
    result := iPresupuesto;
    iPresupuesto := nil; //TPresupuesto.Create;
    FreeAndNil(iPresupuesto);
  end;
end;

mensaje:
21 - 28 bytes: TMemoryStream x 3
61 - 68 bytes: TParametro x 3, TPresupuesto x 1
117 - 124 bytes: TCliente x 2

Código Delphi [-]
  TPresupuesto = class(TObject)
    Private
      Id_Presupuesto:integer;
      Id_Cliente:integer;
      FEmision:TDate;
      Ffin:TDate;
      Cerrado:Boolean;
      Observaciones:String;
      Id_Usuario:integer;
      FRegistro:TDate;
      Cliente:TCliente;
      Eliminado:Boolean;
    Protected
    Public
      Constructor Create;
      Destructor Destroy; override;
      procedure Clear;
      property iId_Presupuesto:Integer read Id_Presupuesto write Id_Presupuesto;
      property iId_Cliente:integer     read Id_Cliente     write Id_Cliente;
      property iFEmision:TDate         read FEmision       write FEmision;
      property iFfin:TDate             read Ffin           write Ffin;
      property iCerrado:Boolean        read Cerrado        write Cerrado;
      property iObservaciones:String   read Observaciones  write Observaciones;
      property iId_Usuario:integer     read Id_Usuario     write Id_Usuario;
      property iFRegistro:TDate        read FRegistro      write FRegistro;
      property iCliente:TCliente       read Cliente        write Cliente;
      property iEliminado:Boolean      read Eliminado      write Eliminado;
  end;

procedure TPresupuesto.Clear;
begin
  Id_Presupuesto := 0;
  Id_Cliente     := 0;
  FEmision       := 0.0;
  Ffin           := 0.0;
  Cerrado        := false;
  Observaciones  := '';
  Id_Usuario     := 0;
  FRegistro      := 0.0;
  Cliente        := TCliente.Create;
  Eliminado      := false;
end;

constructor TPresupuesto.Create;
begin
  inherited;
  Clear;
end;

destructor TPresupuesto.Destroy;
begin
  FreeAndNil(Cliente);
  inherited;
end;

//--- La clase cliente

  TCliente = class(TObject)
    Private
      Id_Cliente:integer;
      Id_ClienteBrocker:integer;
      Brocker:boolean;
      RazonSocial:String;

      .......
      DireccionAnexo4:String;
      Comentarios:String;
    Protected
    Public
      Constructor Create;
      Destructor Destroy; override;
      procedure Clear;
      property iId_Cliente:Integer           read Id_Cliente           write Id_Cliente;
      property iId_ClienteBrocker:integer    read Id_ClienteBrocker    write Id_ClienteBrocker;
      property iBrocker:boolean              read Brocker              write Brocker;
....
      property iDireccionAnexo3:String       read DireccionAnexo3      write DireccionAnexo3;
      property iDireccionAnexo4:String       read DireccionAnexo4      write DireccionAnexo4;
      property iComentarios:String           read Comentarios          write Comentarios;
      property iTipoDocumento:TParametro     read TipoDocumento        write TipoDocumento;
  end;

{ TCliente }

procedure TCliente.Clear;
begin
  Id_Cliente           := 0;
  Id_ClienteBrocker    := 0;
  Brocker              := false;
  ......
  Comentarios          := '';
  TipoDocumento        := TParametro.Create;
end;

constructor TCliente.Create;
begin
  inherited;
  Clear;
end;

destructor TCliente.Destroy;
begin
  FreeAndNil(TipoDocumento);
  inherited;
end;

//-- La Clase TParametro - que es la que tiene TMemoryStream --//

  TParametro = class(TObject)
    Private
      Id_Parametro:integer;
      Id_TipoParametro:integer;
      Nombre:String;
      NombreCorto:String;
      Abreviatura:String;
      ValorInt:integer;
      ValorReal:real;
      ValorFecha:TDate;
      ValorMemo:wideString;
      ValorImagen:TMemoryStream;
      edita:boolean;
      elimina:boolean;
      NombreTipoParametro:String;
    Public
      property iId_Parametro:integer       read Id_Parametro        write Id_Parametro;
      property iId_TipoParametro:integer   read Id_TipoParametro    write Id_TipoParametro;
      property iNombre:String              read Nombre              write Nombre;
      property iNombreCorto:String         read NombreCorto         write NombreCorto;
      property iAbreviatura:String         read Abreviatura         write Abreviatura;
      property iValorInt:integer           read ValorInt            write ValorInt;
      property iValorReal:Real             read ValorReal           write ValorReal;
      property iValorFecha:TDate           read ValorFecha          write ValorFecha;
      property iValorMemo:wideString       read ValorMemo           write ValorMemo;
      property iValorImagen:TMemoryStream  read ValorImagen         write ValorImagen;
      property iedita:boolean              read edita               write edita;
      property ielimina:boolean            read elimina             write elimina;
      property iNombreTipoParametro:String read NombreTipoParametro write NombreTipoParametro;
      Constructor Create;
      Destructor Destroy; override;
      procedure Clear;
  end;

{ TParametro }

procedure TParametro.Clear;
begin
  Id_Parametro      := 0;
  Id_TipoParametro  := 0;
  Nombre            := '';
  NombreCorto       := '';
  Abreviatura       := '';
  ValorInt          := 0;
  ValorReal         := 0;
  ValorFecha        := 0.0;
  ValorMemo         := '';
  ValorImagen       := TMemoryStream.Create;
  edita             := true;
  elimina           := true;
  ValorImagen.Clear;
end;

Constructor TParametro.Create;
begin
  inherited;
  Clear;
end;

destructor TParametro.Destroy;
begin
  FreeAndNil(ValorImagen);
  inherited;
end;

He revisado varias veces pero creo que se me esta pasando un avión por los ojos y no me estoy dando cuenta, por favor amigos ayúdenme que ya llevo varios días en esto y no puedo dar con la solución final.
Muchas gracias de antemano.

[javicho_villa]

Buenas, les comento después de revisar y revisar mi código, logre mejorar mucho las perdidas de memoria, resulta que cuando creas una clase y dentro de los atributos pones un objeto como atributo este crea una instancia del mismo, que por lo general genera una perdida de memoria, ejemplo:

TPresupuesto = class;
Id:integer;
Cliente: TCliente;
End;

El TCliente tambien tenia como atributo un Tipo de documento de la clase TParametro que generaba a su vez otra perdida de memoria, bueno a paser que sobreescribo el destructor y destruyo estos atributos que son onjetos de otras clases que he creado, siempre generan perdida de memoria asi que simplemente no los estoy usando, por que no son tan necesarios, puedo prescindir de estos por ahora y bajaron bastante las perdidas de memoria.

Me he quedado con solo una perdida de memoria de la clase TPresupuesto que que cada vez que entro al formulario se genera una perdida, is entro 5 veces a ese formaulrio que trabaja con esa clase genera 5 perdidas de memoria, he puesto en el evento OnClose del formulario: Action := caFree; y tambien FReeAndNil(Presupuesto); y no lo libera de la memoria.

Si me podrían dar alguna idea amigos se los voy agradecer bastante

Saludos.

[ecfisa]

Hola.

La verdad es que no veo claramente como estas usando esas clases, pero para crear y liberar recursos dispones de los constructores y destructores. Si TPresupuesto crea un TCliente, es su responsabilidad liberarlo.

Como ejemplo:

Código Delphi [-]

....
type
  TCliente = class
  private
    FId: Integer;
    FNombre: string;
    //...
  public
    property ID: Integer read FId write FId;
    property Nombre: string read FNombre write FNombre;
    //...
  end;

  TPresupuesto = class
  private
    FId: Integer;
    FCliente: TCliente;
  public
    property Id : Integer read FId write FId;
    property Cliente: TCliente read FCliente write FCliente;
    constructor Create;
    destructor Destroy; override;
  end;

{ TCliente }
 //...


{ TPresupuesto }
constructor TPresupuesto.Create;
begin
  inherited;
  FCliente := TCliente.Create;  // crear
end;

destructor TPresupuesto.Destroy;
begin
  if Assigned(FCliente) then 
    FreeAndNil(FCliente);   // liberar
  inherited;
end;

Saludos

[javicho_villa]

Gracias por la respuesta ecfisa, he estado poniendo FreeAndNil(FCliente) siguiendo tu ejemplo, pero no se porque cuando cierro el formulario, a pesar que destruyo los objetos genera una perdida de memoria del TPresupuesto, a psear tambien que en el evento Onclose del formulario he puedo FreeAndNil(Presupuesto).

[javicho_villa]

Finalmente resolví mi problema, todo era un campo donde guardaba una imagen, solo para guardar una imagen nueva los comprimia, pero al editar por defecto se descomprimia, lo controle y ahora hay buena velocidad de respuesta.

Muchas gracias a todos por las respuestas y apoyo

Saludos.