Главная страница
    Top.Mail.Ru    Яндекс.Метрика
Форум: "Основная";
Текущий архив: 2005.10.30;
Скачать: [xml.tar.bz2];

Вниз

Управление курсором   Найти похожие ветки 

 
Viktop   (2005-10-07 15:23) [0]

Приведите пожалуйста небольшой кусок кода, в котором курсор мышки движется от текущих координат (ну, или просто от одной точки к другой), до указанных. Желательно, чтобы скорость движения была "стандартная"


 
Piter ©   (2005-10-07 16:03) [1]

Вопрос: как эмулировать нажатие клавиши или кнопки мыши

Ответ:

1) Для мыши:

procedure MouseClick(Pt: TPoint; BackCursor: boolean = True);

  // Переводим экранные координаты к принятым в mouse_event
  function ScreenToAbsolute(const Pt: TPoint): TPoint;
  begin
    Result.x := Round(Pt.x * 65535 / Screen.Width);
    Result.y := Round(Pt.y * 65535 / Screen.Height);
  end;

var
 OldPt: TPoint;
begin
  if BackCursor then
    OldPt := ScreenToAbsolute(Mouse.CursorPos);
  Pt := ScreenToAbsolute(Pt);
  {Переместим курсор мыши}
  Mouse_Event(MOUSEEVENTF_ABSOLUTE or MOUSEEVENTF_MOVE, Pt.x, Pt.y, 0, 0);
  {Нажамаем левую кнопку мыши}
  Mouse_Event(MOUSEEVENTF_ABSOLUTE or MOUSEEVENTF_LEFTDOWN, Pt.x, Pt.y, 0, 0);
  {Отпускаем левую кнопки мыши}
  Mouse_Event(MOUSEEVENTF_ABSOLUTE or MOUSEEVENTF_LEFTUP, Pt.x, Pt.y, 0, 0);
  if BackCursor then
    {Перемещаем кнопку мыши обратно}
    Mouse_Event(MOUSEEVENTF_ABSOLUTE or MOUSEEVENTF_MOVE, OldPt.x, OldPt.y, 0, 0);
end;


Например поместим на форму две кнопки Button1 и Button2 и в их обработчиках напишем следующее:

procedure TForm1.Button1Click(Sender: TObject);
begin
ShowMessage("Test");
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
MouseClick(Button1.ClientToScreen(Point(2, 2)), True); // Кликаем по первой кнопке..
end;


 
Viktop   (2005-10-07 17:21) [2]

А как сделать-то, чтобы было видно, что курсор движется


 
Piter ©   (2005-10-07 17:53) [3]

Viktop   (07.10.05 17:21) [2]

блин, падумай, а?


 
Sysanin   (2005-10-07 18:39) [4]

Попробуй перемещать курсор не сразу к объекту, а на несколько пикселей и на процедуру поставь таймер с интервалом 15-25 млс. Получится плавное движение мыши.


 
Viktop   (2005-10-07 20:15) [5]

Т.е. Поставить цикла на
Mouse_Event(MOUSEEVENTF_ABSOLUTE or MOUSEEVENTF_MOVE, Pt.x, Pt.y, 0, 0);.
Тока как траекторию расчитать. Подумаю ещё.


 
Viktop   (2005-10-08 14:19) [6]

Что такое LineDDA и как его можно использовать?


 
Джо ©   (2005-10-08 15:27) [7]


>  [6] Viktop   (08.10.05 14:19)
> Что такое LineDDA и как его можно использовать?

Позволяет задать callback-функцию, которая будет вызываться для каждого пиксела отрезка, соеденяющего две точки с указанными координатами.


 
Sysanin   (2005-10-08 15:36) [8]


> Т.е. Поставить цикла на
> Mouse_Event(MOUSEEVENTF_ABSOLUTE or MOUSEEVENTF_MOVE, Pt.
> x, Pt.y, 0, 0);.
> Тока как траекторию расчитать. Подумаю ещё.


Обычный цикл сдесь не подойдёт. Получится то же самое (т. е. курсор мнгновенно переместиться к оъекту). Нужно использовать именно таймер.

Траекторию можешь попробовать посчитать математической линейной функцией (y=ax+b) подставляешь треуемый х - находишь у. Только придётся подумать как расчитать коэфиценты a и b. Хотя это тоже можно: знаешь координаты двух точек принадлежащий этой прямой (курсора и объекта) и решаешь систему с двумя неизвестными. Надеюсь знаешь как?


 
Джо ©   (2005-10-08 15:39) [9]


> [7] Джо ©   (08.10.05 15:27)

Вот тебе элементарный пример.

procedure DDAProc (X,Y: Integer; CustomData: Pointer); stdcall;
begin
 // в CustomData передается указатель на Canvas
 TCanvas(CustomData).TextOut(X,Y,"X");
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
 with Image1.Canvas do
 begin
   Brush.Style := bsClear;
   Font.Name := "Arial";
   Font.Size := 9;
 end;
 LineDDA(0,0,100,100,@DDAProc,Integer(Image1.Canvas));
end;

И "руками" траекторию считать не нужно :)


 
Джо ©   (2005-10-08 15:42) [10]

П.С.
1. Call-back функция НЕ вызывается для начальной и конечной точек отрезка.
2. Чтобы движение не выглядело слишком "механично", в колбэке неплохо бы немного искажать полученные координаты случайным образом +- пару пикселей. Тогда движение будет выглядеть более "ествественно".


 
Джо ©   (2005-10-08 20:14) [11]

Дело было вечером, делать было нечего...
Вот функция, имитирующая передвижение курсора мыши из точки в точку, произведенное рукой человека в тяжком похмелии :)

// callback-функция для LineDDA
procedure DDAProc (X,Y: Integer; CustomData: Pointer); stdcall;
var
 DX,DY: Integer;
begin
 DX := Random(10) - 5;
 DY := Random(10) - 5;
 SetCursorPos(X+DX,Y+DY);
 Sleep(1);
end;

// сабжевая функция
procedure MoveCursorGently (FromPoint,ToPoint: TPoint);
begin
 SetCursorPos (FromPoint.X,FromPoint.Y);
 LineDDA(FromPoint.X,FromPoint.Y,ToPoint.X,ToPoint.Y,@DDAProc,0);
 SetCursorPos (ToPoint.X,ToPoint.Y);
end;

Вызов прост:

procedure TForm1.Button1Click(Sender: TObject);
begin
 MoveCursorGently(Point(0,0),Point(500,500));
end;


 
Viktop   (2005-10-08 20:20) [12]

Вау. Работает. Спасибо


 
Джо ©   (2005-10-08 20:24) [13]

Не, для вящего сходства лучше так:

procedure DDAProc (X,Y: Integer; CustomData: Pointer); stdcall;
var
 DX,DY: Integer;
begin
 if Odd(Random (10)) then
   Exit;
 DX := Random(40) - 80;
 DY := Random(40) - 80;
 SetCursorPos(X+DX,Y+DY);
 Sleep(1);
end;

%-)



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

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

Наверх




Память: 0.48 MB
Время: 0.039 c
14-1129061365
saNat
2005-10-12 00:09
2005.10.30
Куда все катится...


14-1128678203
Труп Васи Доброго
2005-10-07 13:43
2005.10.30
Кто чем может похвалиться?


3-1126863221
REP
2005-09-16 13:33
2005.10.30
Задать триггер на ограничение количества записей


2-1127653225
Fifajan
2005-09-25 17:00
2005.10.30
Перетаскивание окна са определенную область


14-1128491702
vidiv
2005-10-05 09:55
2005.10.30
Что лучше поставить на ноут?





Afrikaans Albanian Arabic Armenian Azerbaijani Basque Belarusian Bulgarian Catalan Chinese (Simplified) Chinese (Traditional) Croatian Czech Danish Dutch English Estonian Filipino Finnish French
Galician Georgian German Greek Haitian Creole Hebrew Hindi Hungarian Icelandic Indonesian Irish Italian Japanese Korean Latvian Lithuanian Macedonian Malay Maltese Norwegian
Persian Polish Portuguese Romanian Russian Serbian Slovak Slovenian Spanish Swahili Swedish Thai Turkish Ukrainian Urdu Vietnamese Welsh Yiddish Bengali Bosnian
Cebuano Esperanto Gujarati Hausa Hmong Igbo Javanese Kannada Khmer Lao Latin Maori Marathi Mongolian Nepali Punjabi Somali Tamil Telugu Yoruba
Zulu
Английский Французский Немецкий Итальянский Португальский Русский Испанский