Hola compis, a ver si me podeis ayudar.
El caso es que tengo una procedure que captura la pantalla (la funcion "printscreen" que uso ultimamente esta sacada de este foro buscando la solucion a mi problema)
y la envia por tcp a un servidor, todo funciona correctamente exepto en un "pequeño" problema, no libera la ram, y mira que se lo digo, pero nada.
Toda la culpa de no liberar la memoria esta en esta funcion "LBitmap.Canvas.CopyRect(r, c, r);" Si no la pongo manda la imagen en blanco, vale, pero la manda y no gasta ni un bit de ram, pero como se la ponga me "come" megas y megas en poco segundos.
Ojo me pasa lo mismo si uso la funcion "vieja" "BitBlt(LBitmap.Canvas.Handle, 0, 0, Screen.Width, Screen.Height, GetWindowDC(GetDesktopWindow), 0, 0, SRCCOPY);"
He aqui el codigo por si quereis probar. Gracias por anticipado.
Código Delphi
[-]procedure TscrServer.SendScreen(AContext: TIdContext; cliente: word);
var
msg: string;
LBuffer: TBytes;
LBitmap: TBitmap;
LBytesStream: TBytesStream;
LPngImage: TPngImage;
c: TCanvas;
r: TRect;
begin
c := TCanvas.Create;
c.Handle := GetWindowDC(GetDesktopWindow);
LBitmap := TBitmap.Create;
LPngImage := TPngImage.Create;
LBytesStream := TBytesStream.Create;
try
r := Rect(0, 0, ScreenWidth, ScreenHeight);
LBitmap.Height := ScreenHeight;
LBitmap.Width := ScreenWidth;
LBitmap.Canvas.CopyRect(r, c, r);
LPngImage.CompressionLevel := calidadCompresion;
LPngImage.Assign(LBitmap);
LPngImage.SaveToStream(LBytesStream);
SetLength(LBuffer, LBytesStream.Size + 1);
Move(LBytesStream.Bytes[0], LBuffer[0], LBytesStream.Size);
msg := '[SCR-' + IntToStr(LBytesStream.Size) + ']';
IdTCPServerSCRresponse(msg, AContext);
ActualizaEstado('>SCR-SERVIDOR-' + AContext.Connection.Socket.Binding.PeerIP +
':' + IntToStr(AContext.Connection.Socket.Binding.PeerPort) +
' ' + msg);
clientes[cliente].IOHandler.Write(LBuffer);
finally
ReleaseDC(0, c.Handle);
FreeAndNil(r);
FreeAndNil(LBitmap);
FreeAndNil(LPngImage);
FreeAndNil(LBytesStream);
SetLength(LBuffer, 0);
end;
EsperaSegundos(0.001);
end;