Print Screen Tela

05/12/2003

0

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

Responder

Posts

05/12/2003

Deus

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]


Responder

Que tal ter acesso a um e-book gratuito que vai te ajudar muito nesse momento decisivo?

Ver ebook

Recomendado pra quem ainda não iniciou o estudos.

Eu quero
Ver ebook

Recomendado para quem está passando por dificuldades nessa etapa inicial

Eu quero

Utilizamos cookies para fornecer uma melhor experiência para nossos usuários, consulte nossa política de privacidade.

Aceitar