Ver resolución y Capturar pantalla

[deliriun]

Hola qué tal ? ... me presento mi nombre es Francisco.

Tengo la siguiente duda.

Estoy trabajando en un Form que tiene la propiedad TransparentColor = clGreen activa y de Color de Form = clGreen ya se daran cuenta como se ve el Form ( Totalmente transparente ) y bien ¿Por qué?... Simple lo que quiero lograr con este Form es que el espacio transparente capture ( Tome una foto ) . Me puse a investigar y encontre un codigo que funciona casi bien.

Unit Unit2;

interface

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

type
TForm2 = class(TForm)
Timer1: TTimer;
procedure Timer1Timer(Sender: TObject);
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form2: TForm2;

implementation

{$R *.dfm}

procedure CapturarPantalla( x, y, iAncho, iAlto: Integer; Imagen: TBitmap );
var
DC: HDC;
lpPal : PLOGPALETTE;
begin
if ( iAncho = 0 ) OR ( iAlto = 0 ) then
Exit;

Imagen.Width := iAncho;
Imagen.Height := iAlto;
DC := GetDc( 0 );

if ( DC = 0 ) then
Exit;

if ( GetDeviceCaps( dc, RASTERCAPS) and RC_PALETTE = RC_PALETTE ) then
begin
GetMem( lpPal, SizeOf( TLOGPALETTE ) + ( 255 * SizeOf( TPALETTEENTRY ) ) );
FillChar( lpPal^, SizeOf( TLOGPALETTE ) + ( 255 * SizeOf( TPALETTEENTRY ) ), #0 );
lpPal^.palVersion := $300;
lpPal^.palNumEntries := GetSystemPaletteEntries( DC, 0, 256, lpPal^.palPalEntry );

if (lpPal^.PalNumEntries <> 0) then
Imagen.Palette := CreatePalette( lpPal^ );

FreeMem( lpPal, SizeOf( TLOGPALETTE ) + ( 255 * SizeOf( TPALETTEENTRY ) ) );
end;

BitBlt( Imagen.Canvas.Handle, (1360 - Form2.Width + 17 ), (768 - Form2.Height + 40), iAncho, iAlto, DC, x, y, SRCCOPY );
ReleaseDc( 0, DC );
end;

procedure TForm2.Timer1Timer(Sender: TObject);
var Imagen: TBitmap;
begin
Imagen := TBitmap.Create;
CapturarPantalla((form2.Left + 8) , (form2.Top + 31) , Screen.Width, Screen.Height, Imagen );
Imagen.SaveToFile( ExtractFilePath( Application.ExeName ) + 'captura.bmp' );
Imagen.Free;
end;
end.

Les envito a los que no saben qué pasa con el codigo que lo prueben ( Se los agradesco un monton)

Mis problemas son 2 (Si alguien encuentra uno más por favor que me lo diga)

1° : Subraye una parte del codigo en que hay un problema , Para que el codigo funcione correctamente se debe saber la resolución exacta que esta usando el usuario por ejemplo la mia = 1360 x 768.
-Quisiera saber como obtner la resolución del usuario para usarlas en una variable y ponerla en el codigo.

2° : El otro problema es que captura el area indicada pero la imagen se guarda con un tamaño muy inmenso ( Se ve la parte que se deseaba capturar y el resto se completa con color blanco ) -Quisiera saber como hacer que solo se vea la parte deseada y no el relleno blanco.

Si alguien me puede ayudar se lo agradecería mucho ... De antemano gracias a todos

[nlsgarcia]

Francisco,

Te sugiero revisar las opciones 3, 9 y 12 de la Guía de Estilo Estándar (http://www.clubdelphi.com/foros/guiaestilo.php)

¡Gracias por tu cooperación! :) ^\||/

Saludos,

Nelson.

[ecfisa]

Hola deliriun.

Aunque innecesario en este caso, la resolución definida se puede obtener de las propiedades DesktopWidth y DesktopHeight de la clase TScreen.

with Screen do
ShowMessage(Format('%d x %d',[DesktopWidth, DesktopHeight]));


Podes reescribir el procedimiento de este modo:

procedure CapturarPantalla(aForm: TForm; Imagen: TBitmap);
var
DC: HDC;
lpPal : PLOGPALETTE;
R: TRect;
p: TPoint;
begin
R:= aForm.ClientRect;
p:= aForm.ClientToScreen(Point(R.Left, R.Top));

Imagen.Width := R.Right - R.Left;
Imagen.Height := R.Bottom - R.Top;

DC := GetDc( 0 );
if ( DC = 0 ) then Exit;

if ( GetDeviceCaps( dc, RASTERCAPS) and RC_PALETTE = RC_PALETTE ) then
begin
GetMem( lpPal, SizeOf( TLOGPALETTE ) + ( 255 * SizeOf( TPALETTEENTRY ) ) );
FillChar( lpPal^, SizeOf( TLOGPALETTE ) + ( 255 * SizeOf( TPALETTEENTRY ) ), #0 );
lpPal^.palVersion := $300;
lpPal^.palNumEntries := GetSystemPaletteEntries( DC, 0, 256, lpPal^.palPalEntry );

if (lpPal^.PalNumEntries <> 0) then
Imagen.Palette := CreatePalette( lpPal^ );

FreeMem( lpPal, SizeOf( TLOGPALETTE ) + ( 255 * SizeOf( TPALETTEENTRY ) ) );
end;

BitBlt( Imagen.Canvas.Handle,
0,
0,
Imagen.Width,
Imagen.Height,
DC,
p.x,
p.y,
SRCCOPY );

ReleaseDc( 0, DC );
end;


Ejemplo de llamada:

...
var
Imagen: TBitmap;
begin
Imagen := TBitmap.Create;
try
CapturarPantalla( Form2, Imagen );
Imagen.SaveToFile( ExtractFilePath( Application.ExeName ) + 'captura.bmp' );
finally
Imagen.Free;
end;
end;


Saludos :)