Como Capturar A Tela

[Vivendo&Aprendendo]

E aí galera

Preciso saber como posso capturar a tela e salvar automaticamente em um diretório como jpg mas esse programa deve trabalhar de forma invisivel?

É que tenho um monte de tela no meu sistema e tenho que apresentar todas elas em um trabalho da faculdade e será muito trabalhoso ir de uma em uma e dar print screen e jogar no paint e salvar.

Por favor é urgente.

Alexandre

[Graymalkin]

A função BitBlt faz isso (capturar a tela). Veja este exemplo que desenha no form a sua desktop atual:

BitBlt(GetDC(Self.Handle), 0, 0, Screen.Width, Screen.Height, GetDC(GetDesktopWindow()), 0, 0, SRCCOPY);

Você só tem que arrumar é um jeito de gravar isso em arquivo.

Abraços,

Graymalkin

[Vivendo&Aprendendo]

e aí galerinha do forum, segue abaixo a resposta para a minha dúvida.

É bgem simples mas resolveu o meu problema não sei se será util para alguém mas pra mim foi duas mãos na roda.

Adicione um Image e dois botoões no form (um para salvar e outro para ocultar).

E ai é só se guir os códigos abaixo:

unit UnCapturar;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, StdCtrls , Buttons, ShellApi,Clipbrd, jpeg;

const
  WM_ICONTRAY = WM_USER + 1;

type
  TFrmCaptura = class(TForm)
    PnCapturar: TPanel;
    Img: TImage;
    PnBtn: TPanel;
    BtnSalvar: TSpeedButton;
    BtnOcultar: TSpeedButton;
    procedure BtnSalvarClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure BtnOcultarClick(Sender: TObject);
  private
    TrayIconData: TNotifyIconData;
    { Private declarations }
  public
    { Public declarations }
    procedure TrayMessage(var Msg: TMessage); message WM_ICONTRAY;
  end;

var
  FrmCaptura: TFrmCaptura;
  Contador:Cardinal;

implementation

{$R *.dfm}

procedure TFrmCaptura.BtnSalvarClick(Sender: TObject);
var  Bitmap : TBitmap;
     JP : TJPEGImage;
     Caminho:String;
begin
  // keybd_event(vk_snapshot,1, 0, 0); {Janela Ativa}
  keybd_event(vk_snapshot,0, 0, 0); {Tela Toda}
  Application.ProcessMessages;
  try
    Bitmap := TBitMap.create;
    JP := TJPEGImage.Create;
    JP.Performance := jpBestQuality;
    try
      inc(Contador);
      Caminho := 'C:\Tela' + FormatFloat('0000',Contador)+'.jpg';
      Bitmap.LoadFromClipBoardFormat(cf_BitMap,ClipBoard.GetAsHandle(cf_Bitmap),0);
      Img.Picture.Bitmap := Bitmap;
      JP.Assign(Img.Picture.Graphic);
      Jp.SaveToFile(Caminho);
      ShowMessage('Salvou em ' + #13 + caminho);
    finally
      Bitmap.free;
    end;
  except
    ShowMessage('Erro no formato da área de transferência');
  end;
end;

procedure TFrmCaptura.FormCreate(Sender: TObject);
begin
   with TrayIconData do
    begin
      cbSize := SizeOf(TrayIconData);
      Wnd := Handle;
      uID := 0;
      uFlags := NIF_MESSAGE + NIF_ICON + NIF_TIP;
      uCallbackMessage := WM_ICONTRAY;
      hIcon := Application.Icon.Handle;
      StrPCopy(szTip, Application.Title);
    end;
    Shell_NotifyIcon(NIM_ADD, @TrayIconData);
end;

procedure TFrmCaptura.FormDestroy(Sender: TObject);
begin
   Shell_NotifyIcon(NIM_DELETE,@TrayIconData);
end;

procedure TFrmCaptura.TrayMessage(var Msg: TMessage);
begin
   case Msg.LParam of
     WM_LBUTTONDOWN:
        begin
           BtnSalvarClick(Self);
        end;
     WM_RBUTTONDOWN:
        begin
           FrmCaptura.Show;
        end;
     end;   
end;

procedure TFrmCaptura.BtnOcultarClick(Sender: TObject);
begin
   Hide;
end;

initialization
   Contador := 0;
end.

Ele abrirá no tray e com um clique do botão esquerdo ele salva a figura no C:\Tela0000.jpg e com clique do botão direito ele abre o programa.

Flws

[Micheus]

É que tenho um monte de tela no meu sistema e tenho que apresentar todas elas

Para este coso específico, talvez fosse interessante observar o seguinte:

- O objeto TForm possui o método GetFormImage: function GetFormImage: TBitmap;

- O objeto TScreen possui a propriedade ActiveForm: ActiveForm :TForm;

- Há na unit Forms uma variável global Screen: Screen: TScreen;

- A propriedade KeyPreview no form principal, possibilita o tratamento prioritário do teclado;

você poderia provisóriamente (para este caso específico)

- setar a KeyPreview=true (interceptando o teclado em sua plicação);

- escrever um procedimento para OnKeyDown testanto uma tecla pré-definida (p.e., F12);

a) adaptando sua rotina para salvar o bitmap (no post anterior)

procedure GravaFormAtivo;
var 
  Bitmap :TBitMap;
  JP : TJPEGImage;
  Caminho:String;
begin
  JP := TJPEGImage.Create;
  JP.Performance := jpBestQuality;
  try
    Caminho := 'C:\' + Screen.ActiveForm.Name + '.jpg';
    Bitmap := Screen.ActiveForm.GetFormImage;
    JP.Assign(Bitmap.Picture.Graphic);
    Jp.SaveToFile(Caminho);
    ShowMessage('Salvou em ' + #13 + caminho);
  finally
    Bitmap.free;
    JP.Free;
  end;
end;

procedure MainFormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
begin
  if Key = VK_F12 then
  begin
    GravaFormAtivo;
    Key := 0;
  end;
end;

Deste modo (para este caso específico), você não estará fazendo um print screen de toda a área do monitor, mas sim, apenas da tela ativa (similar a utilizar ALT+PRINT SCREEN) o que poupa espaço em disco e no seu arquivo (documento seja ele word, powerpoint, ...). Também terá as imagens com o nome do form, o que facilitará bastante a identificação das mesmas durante o processo de montagem da apresentação.

[Vivendo&Aprendendo]

Olá Micheus

Esta dando erro nesta linha

JP.Assign(Bitmap.Picture.Graphic);

Erro

[Error] UnCapturar.pas(53): Undeclared identifier: 'Picture'

O que pode ser?

[Churc]

adicione Graphics, JPEG em uses

abs

[Vivendo&Aprendendo]

cara coloquei na uses e continua dando erro ...

[Churc]

opa tente

JP.Assign(Bitmap);

[Vivendo&Aprendendo]

cara testei aqui e da erro

Olha o meu código:

unit UnCapturar;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, JPEG, Controls, Forms,
  Dialogs, ExtCtrls, StdCtrls , Buttons, ShellApi, Clipbrd;

const
  WM_ICONTRAY = WM_USER + 1;

type
  TFrmCaptura = class(TForm)
    PnCapturar: TPanel;
    Img: TImage;
    PnBtn: TPanel;
    BtnSalvar: TSpeedButton;
    BtnOcultar: TSpeedButton;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure BtnOcultarClick(Sender: TObject);
    procedure FormKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
  private
    TrayIconData: TNotifyIconData;
    { Private declarations }
  public
    { Public declarations }
    procedure TrayMessage(var Msg: TMessage); message WM_ICONTRAY;
  end;

var
  FrmCaptura: TFrmCaptura;
  Contador:Cardinal;

implementation

{$R *.dfm}

procedure GravaFormAtivo;
var 
  Bitmap :TBitMap;
  JP : TJPEGImage;
  Caminho:String;
begin
  JP := TJPEGImage.Create;
  JP.Performance := jpBestQuality;
  try
    Caminho := 'C:\' + Screen.ActiveForm.Name + '.jpg';
    Bitmap := Screen.ActiveForm.GetFormImage;
    JP.Assign(Bitmap);
    //JP.Assign(Bitmap.Picture.Graphic);
    Jp.SaveToFile(Caminho);
    ShowMessage('Salvou em ' + #13 + caminho);
  finally
    Bitmap.free;
    JP.Free;
  end;
end;

procedure TFrmCaptura.FormCreate(Sender: TObject);
begin
   with TrayIconData do
    begin
      cbSize := SizeOf(TrayIconData);
      Wnd := Handle;
      uID := 0;
      uFlags := NIF_MESSAGE + NIF_ICON + NIF_TIP;
      uCallbackMessage := WM_ICONTRAY;
      hIcon := Application.Icon.Handle;
      StrPCopy(szTip, Application.Title);
    end;
    Shell_NotifyIcon(NIM_ADD, @TrayIconData);
end;

procedure TFrmCaptura.FormDestroy(Sender: TObject);
begin
   Shell_NotifyIcon(NIM_DELETE,@TrayIconData);
end;

procedure TFrmCaptura.BtnOcultarClick(Sender: TObject);
begin
   Hide;
end;

procedure TFrmCaptura.TrayMessage(var Msg: TMessage);
begin
   case Msg.LParam of
     WM_LBUTTONDOWN:
        begin
           BtnSalvarClick(Self);
        end;
     WM_RBUTTONDOWN:
        begin
           FrmCaptura.Show;
        end;
     end;
end;

procedure TFrmCaptura.FormKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  if Key = VK_F12 then
  begin
    GravaFormAtivo;
    Key := 0;
  end;
end;

initialization
   Contador := 0;
end.

Esta dando erro nesta linha:

           BtnSalvarClick(Self);

O que pode ser?

Vlw

[Churc]

BtnSalvar.Click ou BtnSalvar.OnClick(Self);

[Micheus]

Churc, o que você colocou está certo, mas BtnSalvarClick(Self) também funciona. Eu várias vezes utilizo deste modo.

Como Vivendo&Aprendendo, aparentemente postou todo o código da unit, parece mais ser um erro de compilação, já que não encontrei a definição do procedimento nela: procedure TFrmCaptura.BtnSalvarClick(Sender: TObject);

[]s