unit_capscr.pas

DELPHI7程序编写的游戏截图器 生成.EXE文件可以进行游戏截图

unit Unit_capscr;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, AppEvnts, StdCtrls, ExtDlgs,ShellAPI, Menus, mmsystem;

const MY_MESSAGE = WM_USER + 100;

type
  TForm1 = class(TForm)
    ScrollBox1: TScrollBox;
    Image1: TImage;
    Button1: TButton;
    Button2: TButton;
    Timer1: TTimer;
    Button3: TButton;
    Button4: TButton;
    SaveDialog1: TSaveDialog;
    Panel1: TPanel;
    Label1: TLabel;
    Timer2: TTimer;
    Timer3: TTimer;
    PopupMenu1: TPopupMenu;
    About1: TMenuItem;
    N1: TMenuItem;
    Exit1: TMenuItem;
    N2: TMenuItem;
    Option1: TMenuItem;
    procedure Timer1Timer(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
    Function  SavePicture :Boolean;
    procedure Timer2Timer(Sender: TObject);
    procedure Timer3Timer(Sender: TObject);
    procedure About1Click(Sender: TObject);
    procedure Exit1Click(Sender: TObject);
    procedure Option1Click(Sender: TObject);
    
  private
    { Private declarations }
    cursorpos :Tpoint;
    Sender :Tobject;
    procedure WMSysCommand(var Msg: TWMSysCommand);
    message WM_SYSCOMMAND;
    procedure WMhotkeyhandle(var msg:Tmessage);
    message wm_hotkey;
    procedure OnIconNotify(var Message: TMessage);
    message MY_MESSAGE;
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  ExeDir,SaveDir: string;
  AutoSave :Boolean;
  FileTypeJpg :Boolean;
  HotKeyUse  :Boolean;
  HotKey1 :Boolean;
  Hotkey2 :Boolean;
  AutoCapture :Boolean;
  AutoCaptureTime :integer;
  ShowSound :Boolean;

implementation

uses Unit_about,Unit_option,Anti_MoreApps;

const id_SnapShot1 = 115;
const id_SnapShot2 = 116;

{$R *.dfm}

procedure TForm1.Timer1Timer(Sender: TObject);
var
  Fullscreen: Tbitmap;
  FullscreenCanvas: TCanvas;
  dc: HDC;
begin
  timer1.Enabled := false; //取消时钟
  Fullscreen := TBitmap.Create; //创建一个BITMAP来存放图象
  Fullscreen.Width := screen.width;
  Fullscreen.Height := screen.Height;
  DC := GetDC(0); //取得屏幕的 DC，参数0指的是屏幕
  FullscreenCanvas := TCanvas.Create; //创建一个CANVAS对象
  FullscreenCanvas.Handle := DC;

  Fullscreen.Canvas.CopyRect
    (Rect(0, 0, screen.Width, screen.Height), fullscreenCanvas,
    Rect(0, 0, Screen.Width, Screen.Height));
  //把整个屏幕复制到BITMAP中
  FullscreenCanvas.Free; //释放CANVAS对象
  ReleaseDC(0, DC); //释放DC

  image1.picture.Bitmap := fullscreen; //拷贝下的图象赋给IMAGE对象
  image1.Width := fullscreen.Width;
  image1.Height := fullscreen.Height;
  fullscreen.free; //释放bitmap
  form1.WindowState := wsNormal; //复原窗口状态
//  form1.show; //显示窗口
  Form1.SavePicture ;
//  if  return =false then
//    showmessage('AutoSavePicture Error');
  if ShowSound then beep();
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  form1.WindowState := wsMinimized; //最小化程序窗口
  form1.hide; //把程序藏起来
  timer1.enabled := true; //打开记时器
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
   if savedialog1.Execute then
    begin
      form1.Image1.Picture.SaveToFile(savedialog1.filename)
    end;
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
//  form1.Image1.Picture.Bitmap.Free;
//  showmessage(ExtractFileDir(Application.Exename));
// if not HaveApp('{980E9088-9D92-4EA7-8133-96FBD558F0D0}') then
//  begin
    Application.CreateForm(TForm3, Form3);
    Form3.Show;
    Form1.Enabled :=false;
//  end;
end;

procedure TForm1.FormCreate(Sender: TObject);
var
  nid: TNotifyIconData;
begin
  FileTypeJpg :=true;
  AutoSave :=true;
  HotKeyUse :=true;
  HotKey1 :=true;
  Hotkey2 :=true;
  AutoCapture :=false;
  AutoCaptureTime :=60000;
  ShowSound :=True;

  RegisterHotKey(Form1.Handle, id_SnapShot1, 0, VK_SNAPSHOT); //定义热键
  registerhotkey(Form1.handle, id_SnapShot2, MOD_CONTROL or mod_Alt,$43);
  Exedir :=ExtractFileDir(Application.Exename);
  savedir :=Exedir+'\'+'CaptureScreen';

 // SetWindowLong(Handle,GWL_EXSTYLE,WS_MINIMIZEBOX);
  nid.cbSize := sizeof(nid);                  // nid变量的字节数
  nid.Wnd := Handle;                          // 主窗口句柄
  nid.uID := 1;                               // 内部标识，可设为任意数
  nid.hIcon := Application.Icon.Handle;       // 要加入的图标句柄，可任意指定
  nid.szTip := 'CaptureScreen';           // 提示字符串
  nid.uCallbackMessage := MY_MESSAGE;         // 回调函数消息

  nid.uFlags := NIF_ICON or NIF_TIP or NIF_MESSAGE; // 指明哪些字段有效
  if not Shell_NotifyIcon(NIM_ADD, @nid) then begin
    ShowMessage('Failed!');
    Application.Terminate;
  end;

end;

procedure TForm1.FormDestroy(Sender: TObject);
var
  nid: TNotifyIconData;
begin
  UnRegisterHotKey(Form1.Handle, id_SnapShot1);
  UnRegisterHotKey(Form1.Handle, id_SnapShot2);

  nid.cbSize := sizeof(nid);            // nid变量的字节数
  nid.uID := 1;                         //内部标识，与加入小图标时的数一致
  nid.Wnd := Handle;                    //主窗口句柄
  Shell_NotifyIcon(NIM_DELETE, @nid);   //去掉小图标
end;

procedure TForm1.Wmhotkeyhandle(var msg:Tmessage);
begin
  if HotKeyUse then
    begin
      if ( (msg.LParamHi=$43) and (msg.lparamLo=MOD_CONTROL or mod_Alt) and
            HotKey1 )
        or ( (msg.LParamHi=VK_SNAPSHOT) and HotKey2) then
        begin
          Form1.Button1Click(Sender);
        end;
    end;
end;

procedure TForm1.Button4Click(Sender: TObject);
begin
// if not HaveApp('{8988B602-3B1A-4A2E-BD47-F6D7A0F9FC2C}') then
//  begin
    Application.CreateForm(TForm2, Form2);
    Form2.Show;
    Form1.Enabled :=false;
//  end;
end;

Function TForm1.SavePicture :Boolean;
var
  picturesaved :boolean;
  i :integer;
  savename :string;
begin
  PictureSaved :=False;
  i:=1;
  if AutoSave then
    begin
      if not( Directoryexists( savedir)) then
        begin
          // showmessage('NoSaveDir');
          if not( ForceDirectories( savedir)) then
            showmessage('Create SavePicture DIR error');
        end;
      while not( PictureSaved) AND ( i<1000) do
        begin
          if FileTypeJpg then
            savename :=savedir+'\'+'CapScr_'+inttostr(i)+'.jpg'
           else savename :=savedir+'\'+'CapScr_'+inttostr(i)+'.bmp';
          if not( FileExists( savename)) then
            begin
              form1.Image1.Picture.SaveToFile( savename);
              PictureSaved :=True;
              Result :=True;
            end;
          inc(i);
        end;
      Result :=False;
    end
   else Result :=True;
end;

procedure TForm1.WMSysCommand;
begin 
  if (Msg.CmdType = SC_MINIMIZE)
  // or (Msg.CmdType = SC_MAXIMIZE)
    then
     hide else
  inherited;
end;

procedure TForm1.Timer2Timer(Sender: TObject);
begin
  if Label1.Left+ Form1.Width+ 150 <0 then
    label1.Left := label1.Width- 150;
  label1.Left :=label1.Left-1;
end;

procedure TForm1.OnIconNotify(var Message: TMessage);
begin
    if Message.LParam=WM_LBUTTONDOWN then begin
     // application.BringToFront;
     // SetWindowLong(Application.Handle, GWL_EXSTYLE, 2);
     // if Application.MessageBox('Are you sure','Exit', MB_YESNO)=IDYES then Close;
    if enabled then begin
     if visible then hide
       else begin
         show;
     //  setwindowpos(handle,hwnd_topmost,0,0,0,0,swp_nomove or swp_nosize);
       end;
     end;
    end;
     if Message.LParam=WM_RBUTTONDOWN then begin
       getcursorpos(cursorpos);
       popupmenu1.Popup(cursorpos.x,cursorpos.y);
      end;
end;

procedure TForm1.Timer3Timer(Sender: TObject);
begin
{  form1.WindowState := wsMinimized; //最小化程序窗口
  form1.hide; //把程序藏起来
  timer1.enabled := true; //打开记时器}
  Form1.Button1Click(Sender);
end;

{$IFNDEF Win32}
function ShellAbout(Wnd: HWnd; App, Stuff: PChar; Icon: HIcon): Integer;
  far; external 'shell';
{$ENDIF}


procedure TForm1.About1Click(Sender: TObject);
begin
{
  ShellAbout(Application.MainForm.Handle,
             'CaptureScreen',
             'Copyright (c) 2005-2006 安徽工程科技学院 燕军',
             Application.Icon.Handle);}
             Form1.Button4Click(sender);
end;

procedure TForm1.Exit1Click(Sender: TObject);
begin
  close;
end;

procedure TForm1.Option1Click(Sender: TObject);
begin
  Form1.Button3Click(sender);
end;

end.