unit1.pas

定时抓取活动窗口

//***************************************************************
//*作者:刘红军 李传波
//*Email:[e-mail]
//*
//*Delphi园地  http://mydelphi.8u8.com 2002.9.18
//***************************************************************

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, ComCtrls, ExtCtrls, Registry, JPEG;

type
  TForm1 = class(TForm)
    Label1: TLabel;
    Label2: TLabel;
    CheckBox1: TCheckBox;
    Button1: TButton;
    Button2: TButton;
    UpDown1: TUpDown;
    Edit1: TEdit;
    Timer1: TTimer;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure CheckBox1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
  private
    { Private declarations }
    //热键标识ID
    id:Integer;
    procedure WMHotKey(var Msg:TWMHotKey);
    message WM_HOTKEY;
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation
//自定义函数,随机取得8位a到z之间字符串,作为JPG格式图像的文件名
function RandomFileName():String;
var
  str1:string;
  i:integer;
begin
  Randomize;
  for i:=1 to 8 do
    str1:=str1+chr(97+random(26));
  RandomFileName:=str1;
end;
//自定义函数,实现BMP格式的图像到JPG格式的转换
procedure BMPToJPG(BmpFileName:string);
var
  jpeg:TJPEGImage;
  bmp:TBitmap;
begin
  bmp:=TBitmap.Create;
  try
    bmp.LoadFromFile(BmpFileName);
    jpeg:=TJPEGImage.Create;
    try
      jpeg.Assign(bmp);
      jpeg.Compress;
      //以随机文件名保存在与EXE文件同目录下
      jpeg.SaveToFile(ExtractFilePath(Application.ExeName)+RandomFileName+'.jpg');
    finally
      jpeg.Free;
    end;
  finally
     bmp.Free;
  end;
end;
{$R *.DFM}

{ TForm1 }
//捕获热键消息
procedure TForm1.WMHotKey(var Msg: TWMHotKey);
begin
//如果按下热键,停止抓屏,并且显示窗体
  if msg.HotKey=id then
  begin
    Form1.Visible:=True;
    Timer1.Enabled:=False;
  end;
end;

procedure TForm1.FormCreate(Sender: TObject);
Const
//ALD、CTRL和S的虚拟键值
  MOD_ALT=1;
  MOD_CONTROL=2;
  VK_S=ord('S');
  var RegF:TRegistry;
begin
//首行判断程序是否已经运行,本程序只允许运行一个副本
  if GlobalFindAtom('MyHotKey')=0 then
  begin
  //注册全局热键Ctrl+Alt+S
    id:=GlobalAddAtom('MyHotKey');
    RegisterHotKey(handle,id,MOD_CONTROL+MOD_ALT,VK_S);
  end
  else
    Halt;
  //读取注册表,根据是否设置了开机自动运行,而设置CheckBox1的状态
  RegF:=Tregistry.Create;
  RegF.RootKey:=HKEY_LOCAL_MACHINE;
  try
    RegF.OpenKey('SOFTWARE\Microsoft\Windows\CurrentVersion\Run',True);
    if RegF.ValueExists('Capture') then
      CheckBox1.Checked:=True
    else
      CheckBox1.Checked:=False;
  except

  end;
   RegF.CloseKey;
   RegF.Free;
//设置定时器时间间隔,开始抓屏
   Timer1.Interval:=StrToInt(Edit1.Text)*1000;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
//热键呼出窗体后,用户可修改抓屏的时间间隔,单击重新开始抓屏
  Timer1.Enabled:=True;
  Timer1.Interval:=StrToInt(Edit1.Text)*1000;
  Form1.Hide;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
var
  Bild:TBitmap;
  c:TCanvas;
  r,t:TRect;
  h:THandle;
  ExeFilePath:string;
begin
  ExeFilePath:=ExtractFilePath(Application.ExeName);
  c:=TCanvas.Create;
  c.Handle:=GetWindowDC(GetDesktopWindow);
  //获得当前活动窗口的句柄
  h:=GetForeGroundWindow;
  Bild:=TBitmap.Create;
  if h<>0 then
  //结构t保存该窗口的左上角和右下角的坐标值(相对于屏幕左上角)
    GetWindowRect(h,t);
  try
    r:=Rect(0,0,t.Right-t.Left,t.Bottom-t.Top);
    Bild.Width:=t.Right-t.Left;
    Bild.Height:=t.Bottom-t.Top;
    Bild.Canvas.CopyRect(r,c,t);
    //抓屏结果保存在与EXE相同目录下
    Bild.SaveToFile(ExeFilePath+'screen.bmp');
  finally
    Bild.Free;
  end;
  //将文件转换成JPG格式,以减少磁盘空间的占用
    BMPToJPG(ExeFilePath+'screen.bmp');
end;

procedure TForm1.CheckBox1Click(Sender: TObject);
var
  RegF:TRegistry;
begin
  RegF:=Tregistry.Create;
  RegF.RootKey:=HKEY_LOCAL_MACHINE;
  try
    RegF.OpenKey('SOFTWARE\Microsoft\Windows\CurrentVersion\Run',True);
    //设置开机是否自动运行
    if CheckBox1.Checked then
    begin
      RegF.DeleteValue('Capture');
      RegF.WriteString('Capture',Application.ExeName);
    end
    else
      RegF.DeleteValue('Capture');
  except

  end;
   RegF.CloseKey;
   RegF.Free;

end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  Application.Terminate;
  Form1.Close;
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
//窗体关闭时释放全局热键
  UnregisterHotKey(handle,id);
  GlobalDeleteAtom(id);
end;

end.