ITPub博客

首页 > 应用开发 > IT综合 > 利用热键控制鼠标移动的一个程序 (转)

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

原创 IT综合 作者:worldblog 时间:2007-12-10 10:30:40 0 删除 编辑
利用热键控制鼠标移动的一个程序 (转)[@more@]

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

本程序的热键为小键盘的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

 

 

 


来自 “ ITPUB博客 ” ,链接:http://blog.itpub.net/10752043/viewspace-990860/,如需转载,请注明出处,否则将追究法律责任。

请登录后发表评论 登录
全部评论
  • 博文量
    6241
  • 访问量
    2411060