利用热键控制鼠标移动的一个程序

时间：2015-12-21 01:49:14 所属分类：计算机技术 浏览量:

- 本程序可以使用热键来将鼠标移动到某一个指定的坐标。是一个定义热键的示例程序。 本程序的热键为小键盘的5，在编辑框内可以指定坐标。 unit MainUnit; interface uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtr

-

本程序可以使用热键来将鼠标移动到某一个指定的坐标。是一个定义热键的示例程序。

本程序的热键为小键盘的5，在编辑框内可以指定坐标。

unit MainUnit;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, Mask;

type
TForm1 = class(TForm)
btnSetHK: TButton;
btnExit: TButton;
GroupBox2: TGroupBox;
Label3: TLabel;
Label4: TLabel;
btnUnsetHK: TButton;
edYPos: TMaskEdit;
edXPos: TMaskEdit;
Memo: TMemo;
procedure btnExitClick(Sender: TObject);
procedure btnSetHKClick(Sender: TObject);
procedure btnUnsetHKClick(Sender: TObject);
procedure OnHotKey(var Message: TWMHOTKEY); message WM_HOTKEY;
procedure FormDestroy(Sender: TObject);
public
{ Public declarations }
end;

var
Form1: TForm1;

const
idHotKey : WORD = 0;

implementation

{$R *.DFM}

procedure TForm1.btnExitClick(Sender: TObject);
begin

Close;
end;

procedure TForm1.btnSetHKClick(Sender: TObject);
begin
if idHotKey<>0 then Exit;
idHotKey := GlobalAddAtom('EmuMouse'); //给热键取得一个唯一的标识
RegisterHotKey(Handle, idHotKey, 0, VK_NUMPAD5); //注册热键
end;

procedure TForm1.OnHotKey(var Message: TWMHOTKEY);
var
Point: TPoint;
X, Y: Word;
begin
GetCursorPos(Point); //取回当前坐标

try
X := StrToInt(edXPos.Text);
Y := StrToInt(edYPos.Text);
except
ShowMessage('坐标输入不正确.');
Exit;
end;

try
Mouse_Event(MOUSEEVENTF_ABSOLUTE+MOUSEEVENTF_LEFTDOWN, Point.X, Point.Y, 0, GetMessageExtraInfo);

SetCursorPos(X, Y);

Mouse_Event(MOUSEEVENTF_ABSOLUTE+MOUSEEVENTF_LEFTUP, X, Y, 0, GetMessageExtraInfo);

except
ShowMessage('Error');

end;
end;

procedure TForm1.btnUnsetHKClick(Sender: TObject);
begin
if idHotKey = 0 then Exit;
UnRegisterHotKey(Handle, idHotKey); //注销热键
DeleteAtom(idHotKey); //注销标识
idHotKey := 0;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
btnUnsetHK.Click;
end;

end.

--------

这是dfm文件

object Form1: TForm1
Left = 296
Top = 238
AutoSize = True
BorderStyle = bsDialog
BorderWidth = 8
Caption = '模拟鼠标拖动'
ClientHeight = 265
ClientWidth = 211
Color = clBtnFace
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -12
Font.Name = '新宋体'
Font.Style = []
OldCreateOrder = False
OnDestroy = FormDestroy
PixelsPerInch = 96
TextHeight = 12
object btnSetHK: TButton
Left = 136
Top = 8
Width = 75
Height = 25
Caption = '设置热键(&H)'
TabOrder = 0
OnClick = btnSetHKClick
end
object btnExit: TButton
Left = 136
Top = 72
Width = 75
Height = 25
Caption = '退出(&X)'
TabOrder = 2
OnClick = btnExitClick
end
object GroupBox2: TGroupBox
Left = 0
Top = 0
Width = 129
Height = 97
Caption = '目的坐标'
TabOrder = 3
object Label3: TLabel
Left = 16
Top = 29
Width = 6
Height = 12
Caption = 'X'
end
object Label4: TLabel
Left = 16
Top = 61
Width = 6
Height = 12
Caption = 'Y'
end
object edXPos: TMaskEdit
Left = 32
Top = 24
Width = 73
Height = 20
EditMask = '0000;1;_'
MaxLength = 4
TabOrder = 0
Text = '0000'
end
object edYPos: TMaskEdit
Left = 32
Top = 56
Width = 73
Height = 20
EditMask = '0000;1;_'
MaxLength = 4
TabOrder = 1
Text = '0000'
end
end
object btnUnsetHK: TButton
Left = 136
Top = 40
Width = 75
Height = 25
Caption = '取消热键(&U)'
TabOrder = 1
OnClick = btnUnsetHKClick
end
object Memo: TMemo
Left = 0
Top = 104
Width = 209
Height = 161
TabOrder = 4
end
end

转载请注明来自：http://www.zazhifabiao.com/lunwen/gcjs/jsjjs/36434.html