模拟鼠标(100分)

  • 主题发起人 主题发起人 lhxu
  • 开始时间 开始时间
SetCursorPos,然后发送鼠标事件
 
VOID mouse_event(
DWORD dwFlags, // flags specifying various motion/click variants
DWORD dx, // horizontal mouse position or position change
DWORD dy, // vertical mouse position or position change
DWORD dwData, // amount of wheel movement
DWORD dwExtraInfo // 32 bits of application-defined information
);

 
我倒,模拟鼠标动作?模拟鼠标形状?...
what about sendmessage WM_MOUSEXXX?
 
不好意思,赶快把CJ小弟弟扶起来(CJ大富翁之最--年轻)
我的意思是用键盘的 方向建模拟鼠标的动作
 
放置一个button,设置form.keypreview=true;
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls,math;
type
TForm1 = class(TForm)
Button1: TButton;
procedure FormKeyPress(Sender: TObject;
var Key: Char);
procedure Button1Click(Sender: TObject);
procedure FormKeyDown(Sender: TObject;
var Key: Word;
Shift: TShiftState);
procedure FormKeyUp(Sender: TObject;
var Key: Word;
Shift: TShiftState);
procedure FormDblClick(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;
Step:integer=4;
do
wn:boolean=false;
implementation
{$R *.DFM}
procedure TForm1.FormKeyPress(Sender: TObject;
var Key: Char);
var mousepos:tpoint;
begin
case key of
'*': SetCursorPos(trunc(screen.Width/2),trunc(screen.height/2));
'a','A':
{left}
begin
GetCursorPos(mousepos);
SetCursorPos(max(mousepos.x-step,0),mousepos.y);
end;
'd','D':
{Right}
begin
GetCursorPos(mousepos);
SetCursorPos(min(screen.Width,mousepos.x+step),mousepos.y);
end;
's','S':
{Down}
begin
GetCursorPos(mousepos);
SetCursorPos(mousepos.x,min(screen.width,mousepos.y+step));
end;
'w','W':
{Up}
begin
GetCursorPos(mousepos);
SetCursorPos(mousepos.x,max(0,mousepos.y-step));
end;
end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
Close;
end;

procedure TForm1.FormKeyDown(Sender: TObject;
var Key: Word;
Shift: TShiftState);
begin
if (key=ord('o'))or(key=ord('O')) then
mouse_event(MOUSEEVENTF_LEFTDOWN,0,0,0,0);
end;

procedure TForm1.FormKeyUp(Sender: TObject;
var Key: Word;
Shift: TShiftState);
begin
if (key=ord('o'))or(key=ord('O')) then
mouse_event(MOUSEEVENTF_LEFTUP,0,0,0,0);
end;

procedure TForm1.FormDblClick(Sender: TObject);
begin
ShowMessage('this isdo
ubleclick');
end;

end.
 
方向键?没看清,那全要放在keydown里了.
 
怎么没了响应?我给你改一个
unit keydown;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls,math;
type
TForm1 = class(TForm)
procedure FormKeyDown(Sender: TObject;
var Key: Word;
Shift: TShiftState);
procedure FormKeyUp(Sender: TObject;
var Key: Word;
Shift: TShiftState);
procedure FormDblClick(Sender: TObject);
procedure FormShow(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;
Step:integer=4;
implementation
{$R *.DFM}
procedure TForm1.FormKeyDown(Sender: TObject;
var Key: Word;
Shift: TShiftState);
var mousepos:tpoint;
begin
case key of
ord('*'):{reset mouse pos} SetCursorPos(trunc(screen.Width/2),trunc(screen.height/2));
VK_LEFT:
{left}
begin
GetCursorPos(mousepos);
SetCursorPos(max(mousepos.x-step,0),mousepos.y);
end;
VK_RIGHT:
{Right}
begin
GetCursorPos(mousepos);
SetCursorPos(min(screen.Width,mousepos.x+step),mousepos.y);
end;
VK_DOWN:
{Down}
begin
GetCursorPos(mousepos);
SetCursorPos(mousepos.x,min(screen.width,mousepos.y+step));
end;
VK_UP:
{Up}
begin
GetCursorPos(mousepos);
SetCursorPos(mousepos.x,max(0,mousepos.y-step));
end;
end;
if (key=ord('o'))or(key=ord('O')) then
mouse_event(MOUSEEVENTF_LEFTDOWN,0,0,0,0);
end;

procedure TForm1.FormKeyUp(Sender: TObject;
var Key: Word;
Shift: TShiftState);
begin
if (key=ord('o'))or(key=ord('O')) then
mouse_event(MOUSEEVENTF_LEFTUP,0,0,0,0);
end;

procedure TForm1.FormDblClick(Sender: TObject);
begin
ShowMessage('this isdo
ubleclick');
end;

procedure TForm1.FormShow(Sender: TObject);
begin
Form1.SetFocus;
end;
 
多人接受答案了。
 
后退
顶部