Ir para conteúdo
Fórum Script Brasil
  • 0

Como Capturar A Tela


Vivendo&Aprendendo

Pergunta

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

Link para o comentário
Compartilhar em outros sites

10 respostass a esta questão

Posts Recomendados

  • 0

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

Link para o comentário
Compartilhar em outros sites

  • 0

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

Link para o comentário
Compartilhar em outros sites

  • 0
É 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.

Link para o comentário
Compartilhar em outros sites

  • 0

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

Link para o comentário
Compartilhar em outros sites

  • 0

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

Link para o comentário
Compartilhar em outros sites

Participe da discussão

Você pode postar agora e se registrar depois. Se você já tem uma conta, acesse agora para postar com sua conta.

Visitante
Responder esta pergunta...

×   Você colou conteúdo com formatação.   Remover formatação

  Apenas 75 emoticons são permitidos.

×   Seu link foi incorporado automaticamente.   Exibir como um link em vez disso

×   Seu conteúdo anterior foi restaurado.   Limpar Editor

×   Você não pode colar imagens diretamente. Carregar ou inserir imagens do URL.



  • Estatísticas dos Fóruns

    • Tópicos
      152,3k
    • Posts
      652,4k
×
×
  • Criar Novo...