O soy tonto o .... problema al liberar memoria

[[escafandra]]

Quizás te he liado un poco. Voy a tratar de ser mas claro.

Supón que tenemos un fondo fijo (un campo...) sobre el que se mueve una pelota. Ahora piensa que cada vez que enviemos un fotograma vamos a recordar el previo. A la hora de enviar un nuevo fotograma restamos la nueva imagen y la vieja con el sistema que expliqué en el tema de resta de imágenes. El resultado será que donde previamente estaba la pelota ahora no está, con lo que la resta nos da un círculo con el dibujo del fondo que corresponda en esa posición. La nueva posición de la pelota será representada por la imagen misma de la pelota, y el resto del fondo será negro. Entonces en la resta tenemos:

1- Un fondo negro.
2- Un círculo de imagen de fondo (donde estaba previamente la pelota)
3- Una imagen de la pelota.

Lo sencillo sería trasladar esa imagen resta al PC remoto y pintarla sobre la imagen que tenemos previamente considerando que el fondo negro es transparente (transparencias). Esto parece que funciona muy bien salvo un detalle. Si en la imagen que trasmitimos tenemos zonas negras que no resultan de la resta, se convertirán en zonas trasparentes desvirtuando el resultado final. Para resolver este inconveniente necesitamos diferenciar ambos negros. Tenemos dos opciones o usamos el canal alpha del png (cuarto color) para guardar en el lo que debe ser trasparente o usamos una máscara de un bit (blanco-negro). Esta opción nos permitirá trabajar con formato jpg u otros sin canal alpha. De modo que la máscara lleva la información de lo que será transparente.

Entonces, ¿para que queremos el negro de la imagen resultante de la resta de imágenes?. Pues para que al comprimirla, en el formato que sea, no ocupe lugar.

Espero que con esta explicación entiendas lo que pretendo trasmitir, a veces no me se explicar lo suficientemente bien. Ahora solo te queda estudiar el código para conseguir transparencias con máscaras y la resta de imágenes para que te quede todo un poco mas claro.

Perdona por el rollo y cambiarte los esquemas. Es bastante tarde, mis neuronas no funcionan al 100% y si sigo, te lio mas.


Saludos.

[cesarsoftware]

Hola escafandra
Gracias por tus aclaraciones, que se entienen muy bien. Solo me falta entender como componer la imagen con la resta enviada. Quiza me lo expliques mejor mas adelante, pero ahora otro tema que quiza te interese bastante mas.

Ya he aplicado la resta de imagenes.
Despues de muchas pruebas y comprobar que solo funciona si creo como globales los Bitmap que usa CreateSubtractBitmap en vez de crear (no la anterior oldScreen porque esa tiene que ser global si o si) y destruir los objetos cada vez. Con la funcion que presento abajo (muchas gracias por CreateSubstractBitmap) ya envio solo la diferencia. Me queda "completar" la imagen en destino (ahora solo se ve la diferencia/resta, jejeje). Aunque se envie solo la diferencia en bitmap ocupa un monton, asi que sigo enviando en png.
Peeeerooooo.. Al usar tu funcion consecutivamente, a los pocos segundos..."Out of memory resources", si mando la pantalla completa (es decir sin usar la funcion) se puede tirar horas sin "romperse" y sin consumir ram (que es el principio de este hilo, que nos estamos desviando, jejeje).

¿Se te ocurre que puede ser?

Código Delphi [-]
var
    oldScreen: TBitMap;
    LScreen: TBitmap;

procedure TscrServer.ScreenShot(Image: TBitmap);
var
  DC: HDC;
begin
  DC := GetDC(GetDesktopWindow);
  try
    Image.Canvas.Lock;
    Image.Width := GetDeviceCaps(DC, HORZRES);
    Image.Height := GetDeviceCaps(DC, VERTRES);
    BitBlt(Image.Canvas.Handle, 0, 0, Image.Width,
           Image.Height, DC, 0, 0, SRCCOPY);
    Image.Canvas.UnLock;
  finally
    ReleaseDC(GetDesktopWindow, DC);
  end;
end;

procedure TscrServer.SendScreen(AContext: TIdContext; cliente: word);
var
  msg: string;
  LBuffer: TBytes;
  LBytesStream: TBytesStream;
  LBitmap: TBitmap;
  LPngImage: TPngImage;
begin
  // Crear bitmap
  LBitmap := TBitmap.Create;
  LPngImage := TPngImage.Create;
  // Capturar pantalla
  ScreenShot(LScreen);
  // Obtener la diferencia si ya a enviado la pantalla completa
  if primeravez = True then
    LBitmap.Handle := CreateSubstractBitmap(LScreen.Canvas.Handle, oldScreen.Canvas.Handle)
  else
  begin
    LBitmap.Canvas.Lock;
    LBitmap.Assign(LScreen);
    LBitmap.Canvas.UnLock;
  end;
  LBytesStream := TBytesStream.Create;
  try
    // convertir bitmap en PNG
    LPngImage.CompressionLevel := calidadCompresion;
    LPngImage.Canvas.Lock;
    LPngImage.Assign(LBitmap);
    LPngImage.Canvas.Unlock;
    // pasa el PNG a Stream
    LPngImage.SaveToStream(LBytesStream);
    // pasar el stream al buffer de TBytes
    SetLength(LBuffer, LBytesStream.Size + 1);
    Move(LBytesStream.Bytes[0], LBuffer[0], LBytesStream.Size);
    // enviar pantalla al cliente
    if primeravez = False then
    begin
      msg := '[SCR-' + IntToStr(LBytesStream.Size) + ']';
      primeravez := True;
    end
    else
      msg := '[DIF-' + 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
    // liberar memoria
    LBitmap.Free;
    LPngImage.Free;
    LBytesStream.Free;
    SetLength(LBuffer, 0);
  end;
  // Guardar pantalla actual para proxima comparacion
  oldScreen.Canvas.Lock;
  oldScreen.Assign(LScreen);
  oldScreen.Canvas.Unlock;
  EsperaSegundos(0.001);
end;

¿Voy pididiendo algo para picar?

[[escafandra]]

Hoy he tenido un día muy liado. No tengo tiempo de analizar despacio tu código. Sólo decirte que CreateSubstractBitmap Crea un HBITMAP que debe ser liberado bien por la API DeleteObject, o bien por un objeto TBitmap al que se le asigna dicho HBITMAP.

Por lo demás decirte que Grandes bucles con repetición de llamadas a CreateSubstractBitmap no crean problemas con la memoria:

Código Delphi [-]
var
  i: integer;
  Bitmap: TBitmap;
begin
  for i:= 0 to 3500 do
  begin
    Bitmap:= TBitmap.Create;
    Bitmap.Handle:= CreateSubstractBitmap(Image2.Canvas.Handle, Image1.Canvas.Handle);
    Image3.Picture.Bitmap.Assign(Bitmap);
    Bitmap.Free;
  end;
end;

Saludos.

[[escafandra]]

Creo que tu código puede simplificarse. No puedo correrlo en mi delphi 7 pero he realizado una prueba estable.
La prueba consiste en guardar la pantalla anterior, capturar una nueva, restar ambas y visualizar los resultados en 3 TImages. Al mismo tiempo Vuelco la resta en un TSream y simulo que lo envío por un socket. El proceso es repetido hasta la saciedad por un Timer a 100 ms.

Te expongo el código usado:

Código Delphi [-]
unit Unit1;

interface

uses
  Windows, WinSock, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls;

type
  TForm1 = class(TForm)
    Image3: TImage;
    Image1: TImage;
    Image2: TImage;
    Timer1: TTimer;
    procedure FormCreate(Sender: TObject);
    procedure SendScreen(hSocket: TSOCKET);
    procedure Timer1Timer(Sender: TObject);
  private
    OldScreen, NewScreen, SubScreen: TBitmap;
    primera_vez: boolean;
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.SendScreen(hSocket: TSOCKET);
var
  ScrDC: HDC;
  Stream: TMemoryStream;
begin

  // Capturo la pantalla nueva
  ScrDC:= GetDc(0);
  BitBlt(NewScreen.Canvas.handle, 0, 0, NewScreen.Width, NewScreen.Height, ScrDC, 0, 0, SRCCOPY);
  ReleaseDC(0, ScrDC);

  if primera_vez then
  begin
    OldScreen.Assign(NewScreen);
    Form1.Image1.Picture.Bitmap.Assign(OldScreen);
    primera_vez:= false;
    exit;
  end;

  // Resto las pantallas nueva y antigua
  // Los TImages son para ver lo que pasa y de paso cargar un poco la máquina
  SubScreen.Handle := CreateSubstractBitmap(NewScreen.Canvas.Handle, OldScreen.Canvas.Handle);
  Image1.Picture.Bitmap.Assign(OldScreen);  Image1.Update;
  Image2.Picture.Bitmap.Assign(NewScreen);  Image2.Update;
  Image3.Picture.Bitmap.Assign(SubScreen);  Image3.Update;
  OldScreen.Assign(NewScreen);

  // Envio
  Stream:= TMemoryStream.Create;
  // Aquí debes usar el componente TPngImage...
  SubScreen.SaveToStream(Stream);
  send(hSocket, Pointer(Stream.Memory)^, Stream.Size, 0);
  Stream.Free;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  OldScreen := TBitmap.Create;
  SubScreen := TBitmap.Create;
  NewScreen := TBitmap.Create;
  OldScreen.Width := GetSystemMetrics(SM_CXSCREEN);
  OldScreen.Height := GetSystemMetrics(SM_CYSCREEN);
  NewScreen.Width := GetSystemMetrics(SM_CXSCREEN);
  NewScreen.Height := GetSystemMetrics(SM_CYSCREEN);
  primera_vez:= true;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
begin
   SendScreen(0);
end;

end.

Haz tus pruebas, seguro que no tienes fugas de memoria.


Saludos.

[cesarsoftware]

Hola escafandra

Justamente eso es lo que hice, un formulario con las tres imagenes, lo que no implemente fue el bucle, pero como me funciono entonces lo pase directamente al thread y con objetos creados en vez de timages. Supongo que al estar en un thread quizas habria que hacerlo dentro de la funcion sendscreen en vez de pedirselo a otra, pero tras muchas pruebas el "cuello" no lo tengo en la trasmision de la imagen porque es muy rapido comparando con la gestion de la misma.

Para que veas, estos son los tiempos que se toman en varias maquinas (muy aproximadamente y de memoria)

maquina | bitblt(SRCCOPY | pasar png | write stream | send(-recv( | total recepcion de pantalla
AMD x4 potente | 50-60 ms | 15-30 ms | 70-80 ms | 15-30 ms | 200-250 ms
PC cutre | 200-300 ms | 80-100 ms | 100-120 ms | 15-30 ms | 500-600 ms
Servidor W2003 | 400-500 ms | 130-150 ms | 150-200 ms | 15-30 ms | 800-1000 ms

Es decir al capturar casi 5 megas de pantalla a true color en bimap, luego pasar a png para que se queden entre 700 y 1000 kb, luego pasar ese peso a stream y a tbytes y por fin mandarlo.
Las funciones para obtener la resta de imagenes cursioamente no me suman mucho mas tiempo supongo que por trabajan con HDC en vez de con el Bitmap, pero eso es solo una suposicion. Lo que tengo que conseguir es un "hardcopy" de baja resolucion de tal manera que ya partamos de manejar pesos inferiores y por consiguiente el resto de procesos se aceleren notablemente. Justamente donde no hay diferencia es lo que los pc comparten, la red local, que ademas es la mas rapida. Mandar luego solo la diferecia ya sera muy bueno.

Voy a ver si aislo el codigo y lo pongo en un server y un cliente y podemos compartirlo en la comunidad.

Un saludo.

[[escafandra]]

Empezado por cesarsoftware

Hola escafandra
tras muchas pruebas el "cuello" no lo tengo en la trasmision de la imagen porque es muy rapido comparando con la gestion de la misma...

...Es decir al capturar casi 5 megas de pantalla a true color en bimap, luego pasar a png para que se queden entre 700 y 1000 kb, luego pasar ese peso a stream y a tbytes y por fin mandarlo. Las funciones para obtener la resta de imagenes cursioamente no me suman mucho mas tiempo...

Si te fijas en mi código del anterior mensaje, no es necesario el paso a TBytes, con lo que algo de tiempo ahorras:

Código Delphi [-]
send(hSocket, Pointer(Stream.Memory)^, Stream.Size, 0);

La función CreateSubstractBitmap es muy rápida porque trabaja exclusivamente con la API de Windows. Es por eso que te propuse el uso de la API GDI plus de Windows para realizar la compresión a png y porque el código pesa mucho menos. Algunos mensajes mas arriba te expuse un ejemplo con GDI+, puedes tratar de ver si ganas velocidad.

Para bajar la resolución o número de planos de color puedes tratar de usar un HDC adecuado y realizar el bitblt sobre un bitmap de menor resolución cambiando a un StretchBlt pero el resultado puede ser menos vistoso... Bien es verdad que eso puede ajustar a la resolución del monitor donde se tenga que visualizar el resultado, que si es menor estaría desperdiciando información. Una aproximación puede ser enviar la resolución a la función SendScreen para que se ajuste a ella. De todas formas se debe ser cuidadoso con StretchBlt pues la calidad del resultado puede no la esperada.


Saludos.

[cesarsoftware]

Hola escafandra, vuelvo por aqui,

Digamos que ya tengo el sistema/estructura terminado (he usado parte de tu codigo optimizado, gracias por las aportaciones), solo me quedan algunos ajustes en el tema de envio de teclas y doble-click.

Me gustaria dejarte el proyecto completo para que vieras su rendimiento y lo uses a tu antojo, no es grande solo 3 modulos .pas el el ejecutable que hace de cliente y servidor a la vez, asi se puede copiar/pegar a varios equipos. Tambien "funciona" por intenet al usar un solo socket. Me he desecho de las indy pero por ahi no he ganado mucha velocidad.

El tema principal es que generar la imagen y comprimirla se lleva un moton de milisegundos, la mas rapida de todas ha excepcion del "printscreen" que es forzosamente un bitmap, es en formato jpg. El programilla maneja tanto bmp, jpg como png. En red local lo mas rapido es bmp, porque solo captura y aunque mande 5 mg por la red estos van muy rapidos.

Para el uso que esta pensado es suficiente, que un programa "gestor de lineas" pueda observar lo que hacen sus pc "esclavos" y para eso va "sobrao" es como una camara de vigilancia, puesdes hacer click y mandar teclas para operaciones sencillas. Ahora me gustaria afinarlo mas, pero como estrucutura cliente/servidor es un "ensayo razonable" que diria un erudito.

No se si es sufucientemente madura para dejarlo en el ftp de proyectos, ¿lo dejo ahi? o te lo hago llegar por otro medio.