Print Screen Tela

Delphi

05/12/2003

PESSOAL BOA NOITE!
TO PRECISANDO FAZER UM PROGRAMA DE FORMA QUE QUANDO O USUARIO AO CLICAR EM QUALQUER PONTO DA TELA O MESMO COPIARA A TELA DO WINDOWS E SALVARA EM UM AQUIVO:
POR EXEMPLO ESTOU DIGITANDO ESSE PERGUNTA, COM A TELA FULL SCREEN SE DERREPENTE EU CLICAR COM O MOUSE EM QUALQUER PARTE O PROGRAMA SALVARA A TELA VIRGENTE NO MOMENTO DO CLICK...
GRATO.

[i:fb30dc9285]Título editado pelo Moderador. Digite em minúsculas. (marcelo.c)[/i:fb30dc9285]


Biriga

Biriga

Curtidas 0

Respostas

Deus

Deus

05/12/2003

Muito bem, eu consegui resolver o seu problema, depois de um pouquinho de trabalho. :) É simples, espero que você não se perca no meio da minha explicação:

No form que vai executar esta tarefa, você deverá ter uma variável com de nome [b:7c967350f5]MouseHook[/b:7c967350f5] do tipo [i:7c967350f5]THandle[/i:7c967350f5], e os códigos a seguir para o [i:7c967350f5]OnActivate[/i:7c967350f5] e o [i:7c967350f5]OnClose[/i:7c967350f5] do Form em questão:

procedure TForm1.FormActivate(Sender: TObject);
begin
  MouseHook := SetWindowsHookEx(WH_JOURNALRECORD, @HookParaMouse, hInstance, 0);
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  UnhookWindowsHookEx(MouseHook);
  MouseHook := 0;
end;


Agora, você vai criar uma função dentro do corpo do Form, mas sem referenciá-la na Public, chamada [b:7c967350f5]HookParaMouse[/b:7c967350f5], que irá fazer todo o trabalho sujo. Dentro dela eu coloquei uma função que faz o screenshot, só pra facilitar. :) Enfim:

function HookParaMouse(Code, wParam: Integer; var EventStrut: TEventMsg): Integer; stdcall;

  procedure PegaScreenShot(x, y, Width, Height: Integer; FileName: String);
  var
    dc: HDC; lpPal : PLOGPALETTE;
    bm: TImage;
  begin
    bm := TImage.Create(Form1);

    if ((Width = 0) OR (Height = 0)) then exit;
    bm.Picture.Bitmap.Width := Width;
    bm.Picture.Bitmap.Height := Height;
    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
              BM.Picture.Bitmap.Palette := CreatePalette(lpPal^);

          FreeMem(lpPal, sizeof(TLOGPALETTE) + (255 * sizeof(TPALETTEENTRY)));
        end;
    BitBlt(BM.Picture.Bitmap.Canvas.Handle, 0, 0, Width, Height, Dc, x, y, SRCCOPY);

    if FileExists(FileName) then
      DeleteFile(FileName);

    BM.Picture.Bitmap.SaveToFile(FileName);
    ReleaseDc(0, dc);
  end;
var
  Char1: PChar;
begin
  Result := CallNextHookEx(MouseHook, Code, wParam, Longint(@EventStrut));

  if Code < 0 then Exit;

  if Code = HC_SYSMODALON then Exit;
  if Code = HC_ACTION then
  begin
    if EventStrut.message = WM_LBUTTONDOWN then
      PegaScreenShot(0, 0, Screen.Width, Screen.height, ´C:\Screenshot.bmp´)
    else
      exit;
  end;
end;


Agora, vamos à explicação: o que acontece aqui é que o seu form, quando é ativado, executa o código do [i:7c967350f5]OnActivate[/i:7c967350f5], que faz com que a função [b:7c967350f5]HookParaMouse[/b:7c967350f5] receba todas as mensagens que já saíram da pilha de mensagens. Desta forma, a função irá processar as mensagens e, quando for identificada uma do tipo ´WM_MLBUTTONDOWN´, que significa que o botão esquerdo do mouse foi pressionado, ele vai executar a função interna [b:7c967350f5]PegaScreenShot[/b:7c967350f5], que irá tirar um [i:7c967350f5]Print Screen[/i:7c967350f5] e salvá-lo num arquivo (note que eu chamei de [i:7c967350f5]´C:\Screenshot.bmp´[/i:7c967350f5], mas você pode chamá-lo do que quiser). Quando o form for fechado, ele ativará o [i:7c967350f5]OnClose[/i:7c967350f5], que por sua vez cessará o controle das mensagens para a função [b:7c967350f5]HookParaMouse[/b:7c967350f5]. O código fonte para um Form que não tem nenhum componente, e cuja única função e tirar um [i:7c967350f5]Print Screen[/i:7c967350f5] quando o mouse for pressionado em qualquer lugar, até mesmo fora da aplicação, ficaria assim:

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    procedure FormActivate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
  private
    { Private declarations }
  public
  end;

var
  Form1: TForm1;
  MouseHook: THandle;

implementation

{$R *.dfm}

{ TForm1 }

function HookParaMouse(Code, wParam: Integer; var EventStrut: TEventMsg): Integer; stdcall;

  procedure PegaScreenShot(x, y, Width, Height: Integer; FileName: String);
  var
    dc: HDC; lpPal : PLOGPALETTE;
    bm: TImage;
  begin
    bm := TImage.Create(Form1);

    if ((Width = 0) OR (Height = 0)) then exit;
    bm.Picture.Bitmap.Width := Width;
    bm.Picture.Bitmap.Height := Height;
    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
              BM.Picture.Bitmap.Palette := CreatePalette(lpPal^);

          FreeMem(lpPal, sizeof(TLOGPALETTE) + (255 * sizeof(TPALETTEENTRY)));
        end;
    BitBlt(BM.Picture.Bitmap.Canvas.Handle, 0, 0, Width, Height, Dc, x, y, SRCCOPY);

    if FileExists(FileName) then
      DeleteFile(FileName);

    BM.Picture.Bitmap.SaveToFile(FileName);
    ReleaseDc(0, dc);
  end;
var
  Char1: PChar;
begin
  Result := CallNextHookEx(MouseHook, Code, wParam, Longint(@EventStrut));

  if Code < 0 then Exit;

  if Code = HC_SYSMODALON then Exit;
  if Code = HC_ACTION then
  begin
    if EventStrut.message = WM_LBUTTONDOWN then
      PegaScreenShot(0, 0, Screen.Width, Screen.height, ´C:\Screenshot.bmp´)
    else
      exit;
  end;
end;

procedure TForm1.FormActivate(Sender: TObject);
begin
  MouseHook := SetWindowsHookEx(WH_JOURNALRECORD, @HookParaMouse, hInstance, 0);
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  UnhookWindowsHookEx(MouseHook);
  MouseHook := 0;
end;

end.


Espero que você tenha entendido! Caso não, é só me mandar uma mensagem que tentarei esclarecer quaisquer dúvidas! :)

Um grande abraço, e espero ter sido útil! dEUS[/i]


GOSTEI 0
POSTAR