(Resolvido) delphi

[spyder]

ola pessoal..

Eu tanho este codigo para capturar imagem de tela do pc..

procedure TForm1.CapturarTela;
var
  bmp : TBitmap;
  jpeg : TJPEGImage;
  dia,mes,ano,hora,min,seg, mseg : word;
begin
  bmp := TBitmap.Create;
  Clipboard.Clear;
  keybd_event(vk_snapshot,0, 0, 0);
  Application.ProcessMessages;
  bmp.LoadFromClipboardFormat(CF_BITMAP,clipboard.GetAsHandle(CF_BITMAP),0);
  jpeg := TJPEGImage.Create;
  jpeg.Assign(bmp);
  DecodeDate(now,ano,mes,dia);
  DecodeTime(now,hora,min,seg,mseg);
  jpeg.SaveToFile(ExtractFilePath(Application.ExeName) + inttostr(dia) + '.' + inttostr(mes) + '.' + inttostr(ano) + '.' + inttostr(hora) + '.' + inttostr(min) + '.' + inttostr(seg) + '.jpg');
  jpeg.Free;
  bmp.Free;
end;

O problema e o seguinte quando meto este codigo num timer dá erro (unsupported clipboard format).

Já no button fica tudo bem.

alguém sabe o que to fazendo mal??

Obrigado...

Editado Janeiro 29, 2008 por Micheus
Adicionado o delimitador de código [code] [/code] e identado o código para melhor visualização. Lembre-se de utilizá-los também. ;-)

[Micheus]

O problema e o seguinte quando meto este codigo num timer dá erro (unsupported clipboard format).

por acaso, durante este processo em operação, você não estaria colocando alguma coisa na área de transferência - tipo recortando um texto?

De qualquer modo, acho mais seguro não utilizar o clipboard. Dê uma olhada neste código (ref. About .com). É mais seguro.

quanto a esta parte do código:

DecodeDate(now,ano,mes,dia);
  DecodeTime(now,hora,min,seg,mseg);
  jpeg.SaveToFile(ExtractFilePath(Application.ExeName) + inttostr(dia) + '.' + inttostr(mes) + '.' + inttostr(ano) + '.' + inttostr(hora) + '.' + inttostr(min) + '.' + inttostr(seg) + '.jpg');

dê uma simplificada nele, use a função FormatDateTime:

jpeg.SaveToFile(ExtractFilePath(Application.ExeName) + FormatDateTime('dd.mm.yyyy.hh.nn.ss', now) + '.jpg');

Abraços

[spyder]

O codigo fica assim...

procedure ScreenShot(activeWindow: bool; destBitmap : TBitmap);
var
   w,h : integer;
   DC : HDC;
   hWin : Cardinal;
   r : TRect;
begin
   if activeWindow then
   begin
     hWin := GetForegroundWindow;
     dc := GetWindowDC(hWin);
     GetWindowRect(hWin,r);
     w := r.Right - r.Left;
     h := r.Bottom - r.Top;
   end
   else
   begin
     hWin := GetDesktopWindow;
     dc := GetDC(hWin);
     w := GetDeviceCaps (DC, HORZRES);
     h := GetDeviceCaps (DC, VERTRES);
   end;

   try
    destBitmap.Width := w;
    destBitmap.Height := h;
    BitBlt(destBitmap.Canvas.Handle,
0,
0,
destBitmap.Width,
destBitmap.Height,
DC,
0,
0,
SRCCOPY);
finally
ReleaseDC(hWin, DC);
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
var
b:TBitmap;
begin
b := TBitmap.Create;
try
ScreenShot(TRUE, B);
Image1.Picture.Bitmap.Assign(B);
finally
b.FreeImage;
FreeAndNil(B);
end;

end;

end.

Como faço para gravar a imagem em um determinado lugar?? usei

jpeg.SaveToFile(ExtractFilePath(Application.ExeName) +'.jpg');

Mas não to coseguindo..

Obrigado...

Editado Janeiro 30, 2008 por spyder

[Aleksander]

Olá Spyder, eu uso o código abaixo para copiar e salvar a tela.

unit Unit1;
interface
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, StdCtrls, Jpeg;

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

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);

var
  bitmap : tbitmap;
  jpg : tjpegimage;
  dc : hdc;
  desktoprect : trect;
  desktopcanvas : tcanvas;

  Function GetFileName: String;
var
  szPath: String;
  i: Integer;
begin
  szPath := 'C:\'; //local de gravação mude para o local desejado
  i := 1;
  Result := szPath + 'Screenshot.jpg'; // Screenshot é o nome da imagem, mude se desejar.
  if FileExists(Result) then
  begin
    while (FileExists(szPath + 'Screenshot(' + IntToStr(i) + ').jpg')) do
    Inc(i, 1);
    Result := szPath + 'Screenshot(' + IntToStr(i) + ').jpg';
  end;
end;

begin
  dc:=getdc(getdesktopwindow);
  try
    desktopcanvas:=tcanvas.create;
    bitmap:=tbitmap.create;
    jpg:=tjpegimage.create;
    try
      bitmap.Width:=800;
      bitmap.Height:=600;
      desktopcanvas.handle:=dc;
      desktoprect:=rect(0,0,799,599);
      bitmap.canvas.CopyRect(desktoprect,desktopcanvas,desktoprect);

      with jpg do
      begin
        compressionquality:=100; //qualidade da imagem
        assign(bitmap);
        compress;
        savetofile(GetFileName);
      end;
    finally
      bitmap.free;
      desktopcanvas.free;
      jpg.Free;
    end;
  finally
    releasedc(getdesktopwindow,dc);
  end;
end;

//Se quiser acionamento automático do button1, coloque um timer e escolha o intervalo.
procedure TForm1.Timer1Timer(Sender: TObject);
begin
  Button1.Click;
end;

end.

As imagens serão gravadas na sequência, por exemplo Screenshot[1].jpg, Screenshot[2].jpg, etc.

Aproveito a oportunidade para agradecer ao colega CHURC pela ajuda que me deu na construção deste código.

Boa sorte!

Editado Janeiro 30, 2008 por Micheus
Incluída tag's CODE para melhorar a visualização, bem como identado o código. Utilize a identação também ;)

[spyder]

Obrigado pela vossa ajuda!!

Resolvido!

Editado Janeiro 30, 2008 por spyder

[Guest --carlos --]

otima resposta o codigo esta correto