Ver resolución y Capturar pantalla
 

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.

Código Delphi [-]
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

Francisco,

Te sugiero revisar las opciones 3, 9 y 12 de la Guía de Estilo Estándar

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

Saludos,

Nelson.

Hola deliriun.

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

Código Delphi [-]
 with Screen do
    ShowMessage(Format('%d x %d',[DesktopWidth, DesktopHeight]));

Podes reescribir el procedimiento de este modo:

Código Delphi [-]
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:

Código Delphi [-]
...
var
  Imagen: TBitmap;
begin
  Imagen := TBitmap.Create;
  try
    CapturarPantalla( Form2, Imagen );
    Imagen.SaveToFile( ExtractFilePath( Application.ExeName ) + 'captura.bmp' );
  finally
    Imagen.Free;
  end;
end;

Saludos :)