• 0
Sign in to follow this  
Jhonas

Tirar um Print Screen da tela a cada 5 segundos

Question

o programa abaixo tira uma foto da tela a cada 5 segundos com a informação da data e hora em que ocorreu o evento e grava no drive c:\ com extensão JPG

CODE

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Button1: TButton;
    Image1: TImage;
    Timer1: TTimer;
    procedure Button1Click(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure FormActivate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  dia,mes,ano,hora,min,seg, mseg : word;
  ativa : integer = 0;
implementation

{$R *.DFM}

uses Jpeg;

// capturar uma foto da tela
function CaptureScreenRect( ARect: TRect ): TBitmap;
var ScreenDC: HDC;
begin
  Result := TBitmap.Create;
  with Result, ARect do
  begin
    Width := Right - Left;
    Height := Bottom - Top;
    ScreenDC := GetDC( 0 );

    try
      BitBlt( Canvas.Handle, 0, 0, Width, Height, ScreenDC, Left, Top, SRCCOPY );
    finally
      ReleaseDC( 0, ScreenDC );
    end;
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
   // ativar ou desativar o timer
   if ativa = 0 then
      begin
         Timer1.Interval := 5000;  // tirar uma foto a cada 5 segundos  da tela
         Timer1.Enabled := true;
         ativa := 1;
      end
   else
      begin
         Timer1.Enabled := false;
         ativa := 0;
      end;


end;

procedure TForm1.Timer1Timer(Sender: TObject);
var   bmp : TBitmap;
      jpeg : TJPEGImage;

begin
   DecodeDate(now,ano,mes,dia);
   DecodeTime(now,hora,min,seg,mseg);

   // capturar uma foto da tela
   Image1.picture.Assign(CaptureScreenRect(Rect(0,0,Screen.DesktopWidth,Screen.DesktopHeight)));
   Image1.picture.SaveToFile('c:\imagem'+'.bmp');

   Bmp := TBitmap.Create;
   Bmp.LoadFromFile('c:\imagem.bmp');
   jpeg := TJpegImage.Create;
   jpeg.Assign(bmp);
   // qualidade da foto quanto menor o valor, menor o tamanho do jpeg e menor qualidade
   jpeg.CompressionQuality:=30; //  ideal
   jpeg.SaveToFile('C:\' + inttostr(dia) + '.' + inttostr(mes) + '.' + inttostr(ano) + '.' + inttostr(hora) + '.' + inttostr(min) + '.' + inttostr(seg) + '.jpg');
   jpeg.Free;
   Bmp.Free;


end;

procedure TForm1.FormActivate(Sender: TObject);
begin
   // iniciar o timer parado
   Timer1.Enabled := false;
end;

end.

abraço

Share this post


Link to post
Share on other sites

1 answer to this question

Recommended Posts

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.

Guest
Answer this question...

×   Pasted as rich text.   Paste as plain text instead

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

Sign in to follow this