Главная страница
    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.046 c
14-1129120736
CHES
2005-10-12 16:38
2005.10.30
Помогите с переводом


1-1128767887
Antonn
2005-10-08 14:38
2005.10.30
Ширина выводимого текста на Canvas е


10-1106212117
bmax
2005-01-20 12:08
2005.10.30
TWebBrowser в качестве Com-клиента


14-1129021712
Ega23
2005-10-11 13:08
2005.10.30
Считается-ли хорошим тоном


14-1128934702
Igorek
2005-10-10 12:58
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
Английский Французский Немецкий Итальянский Португальский Русский Испанский