Ver Mensaje Individual
  #3  
Antiguo 23-04-2015
Avatar de ecfisa
ecfisa ecfisa is offline
Moderador
 
Registrado: dic 2005
Ubicación: Tres Arroyos, Argentina
Posts: 10.508
Reputación: 36
ecfisa is a splendid one to beholdecfisa is a splendid one to beholdecfisa is a splendid one to beholdecfisa is a splendid one to beholdecfisa is a splendid one to beholdecfisa is a splendid one to beholdecfisa is a splendid one to behold
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
__________________
Daniel Didriksen

Guía de estilo - Uso de las etiquetas - La otra guía de estilo ....
Responder Con Cita