Форум: "Система";
Текущий архив: 2002.01.28;
Скачать: [xml.tar.bz2];

Вниз

Помогите: необходима эмуляция поведения мыши   Найти похожие ветки 

← →
Zmey   (2001-10-18 02:49) [2]

Лови, я тут как то прикалывался
=================================

unit Unit1;

interface

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

type
TForm1 = class(TForm)
BitBtn1: TBitBtn;
BitBtn2: TBitBtn;
BitBtn3: TBitBtn;
BitBtn4: TBitBtn;
BitBtn5: TBitBtn;
BitBtn6: TBitBtn;
BitBtn7: TBitBtn;
BitBtn8: TBitBtn;
SpinEdit1: TSpinEdit;
SpinEdit2: TSpinEdit;
BitBtn9: TBitBtn;
BitBtn10: TBitBtn;
procedure BitBtn1Click(Sender: TObject);
procedure BitBtn2Click(Sender: TObject);
procedure BitBtn3Click(Sender: TObject);
procedure BitBtn4Click(Sender: TObject);
procedure BitBtn5Click(Sender: TObject);
procedure BitBtn6Click(Sender: TObject);
procedure BitBtn9Click(Sender: TObject);
procedure BitBtn7Click(Sender: TObject);
procedure BitBtn8Click(Sender: TObject);
procedure BitBtn10Click(Sender: TObject);
procedure SpinEdit1Change(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.DFM}
procedure emulate_mouse(dx,dy:integer; flag, m_left, m_right, m_middle:byte);
const pause=200;
var flags:cardinal;
begin
{
кнопки m_left, m_right, m_midlle
0:ничего не происходит
1:кнопка внизу
2:кнопка вверху
3:одиночное нажатие
else:двойноае нажатие

flag
0:установка координат
1:смещение мышки
else:не изменять координат
}

// перемещение мышки
case flag of
0:flags:=MOUSEEVENTF_ABSOLUTE+MOUSEEVENTF_MOVE;
1:flags:=MOUSEEVENTF_MOVE;
else
flags:=0;
end;
mouse_event(flags,round(65535/640*dx),round(65535/480*dy),0,0);

// имитация нажатие кнопок
flags:=0;

// левая кнопка
case m_left of
0:;
1:flags:=flags+MOUSEEVENTF_LEFTDOWN;
2:flags:=flags+MOUSEEVENTF_LEFTUP;
3:flags:=flags+MOUSEEVENTF_LEFTDOWN;
else
flags:=flags+MOUSEEVENTF_LEFTDOWN;
end;

// правая кнопка
case m_right of
0:;
1:flags:=flags+MOUSEEVENTF_RIGHTDOWN;
2:flags:=flags+MOUSEEVENTF_RIGHTUP;
3:flags:=flags+MOUSEEVENTF_RIGHTDOWN;
else
flags:=flags+MOUSEEVENTF_RIGHTDOWN;
end;

// средняя кнопка
case m_middle of
0:;
1:flags:=flags+MOUSEEVENTF_MIDDLEDOWN;
2:flags:=flags+MOUSEEVENTF_MIDDLEUP;
3:flags:=flags+MOUSEEVENTF_MIDDLEDOWN;
else
flags:=flags+MOUSEEVENTF_MIDDLEDOWN;
end;
mouse_event(flags,dx,dy,0,0);

if (m_left>2)and(m_right>2)and(m_middle>2) then exit;

// одиночное нажатие
sleep(pause);
flags:=0;

// левая кнопка
case m_left of
0,1,2:;
3:flags:=flags+MOUSEEVENTF_LEFTUP;
else
flags:=flags+MOUSEEVENTF_LEFTUP;
end;

// правая кнопка
case m_right of
0,1,2:;
3:flags:=flags+MOUSEEVENTF_RIGHTUP;
else
flags:=flags+MOUSEEVENTF_RIGHTUP;
end;

// средняя кнопка
case m_middle of
0,1,2:;
3:flags:=flags+MOUSEEVENTF_MIDDLEUP;
else
flags:=flags+MOUSEEVENTF_MIDDLEUP;
end;
mouse_event(flags,dx,dy,0,0);
if (m_left>3)and(m_right>3)and(m_middle>3) then exit;
// двойное нажатие
sleep(pause);
flags:=0;

// левая кнопка
case m_left of
0,1,2,3:;
else
flags:=flags+MOUSEEVENTF_LEFTDOWN;
end;

// правая кнопка
case m_right of
0,1,2,3:;
else
flags:=flags+MOUSEEVENTF_RIGHTDOWN;
end;

// средняя кнопка
case m_middle of
0,1,2,3:;
else
flags:=flags+MOUSEEVENTF_MIDDLEDOWN;
end;
mouse_event(flags,dx,dy,0,0);

//
sleep(pause);
flags:=0;

// левая кнопка
case m_left of
0,1,2,3:;
else
flags:=flags+MOUSEEVENTF_LEFTDOWN;
end;

// правая кнопка
case m_right of
0,1,2,3:;
else
flags:=flags+MOUSEEVENTF_RIGHTDOWN;
end;

// средняя кнопка
case m_middle of
0,1,2,3:;
else
flags:=flags+MOUSEEVENTF_MIDDLEDOWN;
end;
mouse_event(flags,dx,dy,0,0);

end;

procedure TForm1.BitBtn1Click(Sender: TObject);
begin
emulate_mouse(0,-10,1,0,0,0);
end;

procedure TForm1.BitBtn2Click(Sender: TObject);
begin
emulate_mouse(0,10,1,0,0,0);
end;

procedure TForm1.BitBtn3Click(Sender: TObject);
begin
emulate_mouse(-10,0,1,0,0,0);
end;

procedure TForm1.BitBtn4Click(Sender: TObject);
begin
emulate_mouse(10,0,1,0,0,0);
end;

procedure TForm1.BitBtn5Click(Sender: TObject);
begin
emulate_mouse(0,0,2,3,0,0);
end;

procedure TForm1.BitBtn6Click(Sender: TObject);
begin
emulate_mouse(0,0,2,0,3,0);
end;

procedure TForm1.BitBtn9Click(Sender: TObject);
begin
emulate_mouse(0,0,2,0,0,3);
end;

procedure TForm1.BitBtn7Click(Sender: TObject);
begin
emulate_mouse(0,0,2,4,0,0);
end;

procedure TForm1.BitBtn8Click(Sender: TObject);
begin
emulate_mouse(0,0,2,0,4,0);
end;

procedure TForm1.BitBtn10Click(Sender: TObject);
begin
emulate_mouse(0,0,2,0,0,4);
end;

procedure TForm1.SpinEdit1Change(Sender: TObject);
begin
emulate_mouse(SpinEdit1.Value,SpinEdit2.Value,0,0,0,0);
end;

end.


---

Страницы: 1 вся ветка

Форум: "Система";
Текущий архив: 2002.01.28;
Скачать: [xml.tar.bz2];

Наверх

Память: 0.46 MB
Время: 0.004 c