WEB开发网
开发学院软件开发Delphi 利用热键控制鼠标移动的一个程序 阅读

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

 2006-02-04 13:32:36 来源:WEB开发网   
核心提示:本程序可以使用热键来将鼠标移动到某一个指定的坐标,是一个定义热键的示例程序,利用热键控制鼠标移动的一个程序,本程序的热键为小键盘的5,在编辑框内可以指定坐标

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

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

Tags:利用 热键 控制

编辑录入:爽爽 [复制链接] [打 印]
赞助商链接