Definir salvamento em .gif

[fsK.]

Olá! ..

Estou montando uma lan house aqui no bairro .. e quero ter o maximo de controle doque os usuários fazem nos computadores..

Então.. montei um pequeno aplicativo que pega o nome da janela ativa no windows e começa a tirar print screens..

O meu problema é.. que o código que estou a usar, os prints são salvos sem formato e com 5 MB cada.. então quero saber, como faço para salvar os prints em .gif ou .jpg..

Os códigos que estou a uasr:

{ Tirar print screen }

// 1. Obtem o handle e a posição do mouse

function GetCursorInfo2: TCursorInfo;

var

hWindow: HWND;

pt: TPoint;

pIconInfo: TIconInfo;

dwThreadID, dwCurrentThreadID: DWORD;

begin

Result.hCursor := 0;

ZeroMemory(@Result, SizeOf(Result));

// Encontra a janela "mae" do mouse

if GetCursorPos(pt) then

begin

Result.ptScreenPos := pt;

hWindow := WindowFromPoint(pt);

if IsWindow(hWindow) then

begin

// Pega a thread do owner do mouse

dwThreadID := GetWindowThreadProcessId(hWindow, nil);

// Pega o id da thread atual

dwCurrentThreadID := GetCurrentThreadId;

if (dwCurrentThreadID <> dwThreadID) then

begin

if AttachThreadInput(dwCurrentThreadID, dwThreadID, True) then

begin

// Obtem o handle do cursor

Result.hCursor := GetCursor;

AttachThreadInput(dwCurrentThreadID, dwThreadID, False);

end;

end

else

begin

Result.hCursor := GetCursor;

end;

end;

end;

end;

// 2. Captura tela

function CaptureScreen: TBitmap;

var

DC: HDC;

ABitmap: TBitmap;

MyCursor: TIcon;

CursorInfo: TCursorInfo;

IconInfo: TIconInfo;

begin

// captura tela

DC := GetDC(GetDesktopWindow);

ABitmap := TBitmap.Create;

try

ABitmap.Width := GetDeviceCaps(DC, HORZRES);

ABitmap.Height := GetDeviceCaps(DC, VERTRES);

// BitBlt on our bitmap

BitBlt(ABitmap.Canvas.Handle,

0,

0,

ABitmap.Width,

ABitmap.Height,

DC,

0,

0,

SRCCOPY);

// Cria icone temporario

MyCursor := TIcon.Create;

try

// Devolve informação do cursor

CursorInfo := GetCursorInfo2;

if CursorInfo.hCursor <> 0 then

begin

MyCursor.Handle := CursorInfo.hCursor;

GetIconInfo(CursorInfo.hCursor, IconInfo);

// Desenha o cursor no bmp

ABitmap.Canvas.Draw(CursorInfo.ptScreenPos.X - IconInfo.xHotspot,

CursorInfo.ptScreenPos.Y - IconInfo.yHotspot, MyCursor);

end;

finally

// limpa tudo

MyCursor.ReleaseHandle;

MyCursor.Free;

end;

finally

ReleaseDC(GetDesktopWindow, DC);

end;

Result := ABitmap;

end;

{ Salvar print screens }

procedure TForm1.Timer1Timer(Sender: TObject);

Var

TempStr : string;

begin

Image1.Picture.Assign(CaptureScreen);

TempStr := FormatDateTime('hh-mm-ss',now);

Image1.Picture.SaveToFile('C:\prints\'+TempStr); // Salva os prints

end;

Lembrando a vocês que estou usando um código para pegar o nome da URL ativa.. ele pega e ativar o Timer1.. acho que não é necessario eu mostrar o código aqui.

Quero pedir tambem, mil desculpas por adcionar os códigos assim.. não estou conseguindo adcionar o CODEBOX ou SPOILER .. Ele da o Error 404.

Edited February 27, 2012 by fsK.

[Jhonas]

basta adaptar essa função ao seu código

function BMPtoJPG
   (var BMPpic, JPGpic: string):boolean;
var Bitmap: TBitmap;
    JpegImg: TJpegImage;
begin
  Result:=False;
  Bitmap := TBitmap.Create;
  try
   Bitmap.LoadFromFile(BMPpic);
   JpegImg := TJpegImage.Create;
   try
    JpegImg.Assign(Bitmap);
    JpegImg.SaveToFile(JPGpic);
    Result:=True;
   finally
    JpegImg.Free
   end;
  finally
   Bitmap.Free
  end;

procedure TForm1.Button1Click(Sender: TObject);
begin
   BMPtoJPG('meubitmap.bmp','meujpeg.jpg')
end;

abraço

[fsK.]

Olá Jhonas..

Acontece o seguinte erro:

Constant object cannot be passed as var parameter

No código:

BMPtoJPG('meubitmap.bmp','meujpeg.jpg')

[Jhonas]

ok... vamos a um exemplo pratico

o programa abixo tira uma foto da tela a cada 5 segundos com a informação da data e hora em que ocorreu o evento

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.


end.

OBS: voce pode fazer a adaptação ao seu código ou usar dessa maneira

abraço