Вверх ↑
Этот топик читают: Гость
Ответов: 1120
Рейтинг: 80
#1: 2025-03-30 19:00:04 ЛС | профиль | цитата
Приветствую.

Проверьте кто-нибудь у себя. А то у меня на штатном fpc пункт меню появляется в правом нижнем углу.
Хотя если забить статические координаты в

Idx := TrackPopupMenu(PM.Handle,TPM_NONOTIFY+TPM_RETURNCMD,100,100,0,FC.Handle,nil); 
то все норм

клац


Add(Timer,6227045,448,182)
{
Interval=3000
AutoStop=1
link(onTimer,11767921:doEvent1,[])
}
Add(PopupMenu,9995938,672,294)
{
Menu=#5:menu1|
Point(onEndPopup)
}
Add(MainForm,9535748,371,182)
{
Width=383
Height=286
Point(Handle)
Point(onClose)
}
Add(InlineCode,3935702,756,168)
{
@Hint=#35:https://forum.hiasm.com/topic/68170|
WorkPoints=#12:doMouseClick|11:doMouseDown|9:doMouseUp|15:doKeyBoardPress|14:doKeyBoardDown|12:doKeyBoardUp|11:doMouseMove|0:|
DataPoints=#3:Key|1:X|1:Y|
Code=#15:unit HiAsmUnit;|0:|9:interface|0:|29:uses Windows,kol,Share,Debug;|0:|4:type|28: THiAsmClass = class(TDebug)|10: private|0:|9: public|24: Key,X,Y: THI_Event;|57: procedure doMouseClick(var _Data:TData; Index:word);|60: procedure doKeyBoardPress(var _Data:TData; Index:word);|56: procedure doMouseDown(var _Data:TData; Index:word);|54: procedure doMouseUp(var _Data:TData; Index:word);|56: procedure doMouseMove(var _Data:TData; Index:word);|59: procedure doKeyBoardDown(var _Data:TData; Index:word);|57: procedure doKeyBoardUp(var _Data:TData; Index:word);|5: end;|0:|121:function SendInput(cInputs: UINT; var pInputs: TInput; cbSize: Integer): UINT; stdcall; external user32 name 'SendInput';|0:|0:|14:implementation|0:|5:const|102: _mdown:array[1..3]of cardinal = (MOUSEEVENTF_LEFTDOWN,MOUSEEVENTF_RIGHTDOWN,MOUSEEVENTF_MIDDLEDOWN);|94: _mup:array[1..3]of cardinal = (MOUSEEVENTF_LEFTUP,MOUSEEVENTF_RIGHTUP,MOUSEEVENTF_MIDDLEUP);|21: INPUT_KEYBOARD = 1;|0:|28:procedure MouseDown(b:byte);|3:var|16: inp: TInput;|20: mi: TMouseInput;|5:begin|31: ZeroMemory(@mi, sizeof(mi));|33: ZeroMemory(@inp, sizeof(inp));|26: mi.dwFlags:= _mdown[b];|16: inp.mi := mi;|32: SendInput(b,inp,sizeof(inp));|4:end;|0:|26:procedure MouseUp(b:byte);|3:var|16: inp: TInput;|20: mi: TMouseInput;|5:begin|31: ZeroMemory(@mi, sizeof(mi));|33: ZeroMemory(@inp, sizeof(inp));|24: mi.dwFlags:= _mup[b];|16: inp.mi := mi;|32: SendInput(b,inp,sizeof(inp));|4:end;|0:|0:|31:procedure KeyBoardDown(b:byte);|0:|3:var|37: inp: packed array [0..1] of TInput;|2: |5:begin|33: inp[0].Itype := INPUT_KEYBOARD;|21: inp[0].ki.wVk := b;|25: inp[0].ki.dwFlags := 0;|39: SendInput(2, inp[0], SizeOf(TInput));|4:end;|0:|29:procedure KeyBoardUp(b:byte);|0:|3:var|37: inp: packed array [0..1] of TInput;|2: |5:begin|33: inp[1].Itype := INPUT_KEYBOARD;|21: inp[1].ki.wVk := b;|40: inp[1].ki.dwFlags := KEYEVENTF_KEYUP; |39: SendInput(2, inp[0], SizeOf(TInput));|4:end;|0:|0:|39:procedure MouseMove(posx,posy:integer);|0:|3:var|37: inp: packed array [0..1] of TInput;|2: |5:begin|30: inp[0].Itype := INPUT_MOUSE;|40: inp[0].mi.dwFlags := MOUSEEVENTF_MOVE;|23: inp[0].mi.dx := posx;|23: inp[0].mi.dy := posy;|39: SendInput(1, inp[0], SizeOf(TInput));|4:end;|0:|0:|0:|34:procedure THiAsmClass.doMouseMove;|5:begin|55:MouseMove(ReadInteger(_Data, X),ReadInteger(_Data, Y));|4:end;|0:|0:|0:|0:|36:procedure THiAsmClass.doMouseClick; |3:var|9:mbk:Byte;|5:begin|29:mbk:=ReadInteger(_Data, Key);|15:MouseDown(mbk);|9:Sleep(1);|13:MouseUp(mbk);|4:end;|0:|38:procedure THiAsmClass.doKeyBoardPress;|3:var|9:mbk:Byte;|0:|5:begin|29:mbk:=ReadInteger(_Data, Key);|18:KeyBoardDown(mbk);|9:Sleep(1);|16:KeyBoardUp(mbk);|4:end;|0:|0:|37:procedure THiAsmClass.doKeyBoardDown;|0:|3:var|9:mbk:Byte;|0:|5:begin|29:mbk:=ReadInteger(_Data, Key);|18:KeyBoardDown(mbk);|4:end;|0:|0:|35:procedure THiAsmClass.doKeyBoardUp;|0:|3:var|9:mbk:Byte;|0:|5:begin|29:mbk:=ReadInteger(_Data, Key);|16:KeyBoardUp(mbk);|4:end;|0:|0:|34:procedure THiAsmClass.doMouseDown;|0:|3:var|9:mbk:Byte;|0:|5:begin|29:mbk:=ReadInteger(_Data, Key);|15:MouseDown(mbk);|4:end;|0:|0:|32:procedure THiAsmClass.doMouseUp;|0:|3:var|9:mbk:Byte;|0:|5:begin|29:mbk:=ReadInteger(_Data, Key);|13:MouseUp(mbk);|4:end;|0:|4:end.|
AddHint(-154,-63,193,13,@Hint)
}
Add(DoData,11579248,658,147)
{
Data=Integer(17)
link(onEventData,3935702:doKeyBoardDown,[(713,153)(713,202)])
}
Add(DoData,6207852,658,189)
{
Data=Integer(67)
link(onEventData,3935702:doKeyBoardPress,[])
}
Add(DoData,12133584,658,231)
{
Data=Integer(17)
link(onEventData,3935702:doKeyBoardUp,[(730,237)(730,209)])
}
Add(Hub,2648631,602,182)
{
OutCount=3
link(onEvent1,11579248:doData,[(637,188)(637,153)])
link(onEvent2,6207852:doData,[])
link(onEvent3,12133584:doData,[(637,202)(637,237)])
}
Add(Hub,11767921,504,182)
{
link(onEvent1,9969409:doWork,[(527,188)(527,168)])
link(onEvent2,9995938:doPopupHere,[(529,195)(529,300)])
}
Add(Check,9969409,536,162)
{
link(onEvent,2648631:doEvent1,[(595,168)(595,188)])
}


--- Добавлено в 2025-03-30 19:01:55

и еще...
почему SendInput закоментировано в fpc?

Редактировалось 1 раз(а), последний 2025-03-30 19:01:55
карма: 2

0
Ответов: 4658
Рейтинг: 760
#2: 2025-03-30 19:55:07 ЛС | профиль | цитата
Вызов SendInput неправильный.
Первый параметр указывает количество структур, переданных во втором параметре.
Там, где у тебя в коде используется "array [0..1] of TInput", там их две, что и выражается в первом параметре - 2.
Но заполняешь ты в KeyBoardDown только первую из них (inp[0]), и в KeyBoardUp вторую (inp[1]).
Следовательно, одна из структур остается неочищенной. В результате там находится рандомный мусор, который отличается в Delphi и FPC, что приводит к непредсказуемому поведению.
Потому что по факту эмулируется два нажатия и два отжатия клавиш. А скорее, даже не нажатия, а перемещения мыши.
И даже задействованные структуры надо предварительно очищать по ZeroMemory().
Дополнительно - нажатие и отжатие клавиши не нужно делать отдельными вызовами нажатие-Sleep-отжатие. Достаточно правильно заполнить 2 структуры в массиве - одну на нажатие, вторую на отжатие.

В MouseDown()/MouseUp() первым параметром SendInput() вообще подается "b", который обозначает код кнопки мыши, а не то что должен. Что не даст им работать.

И если заметил, в коде объявлено INPUT_KEYBOARD = 1 - без этого оно бы не работало в Delphi.
Потому что в модуле Windows от Delphi 4 неправильные значения INPUT_MOUSE, INPUT_KEYBOARD.
А в FPC - нормально. Поэтому там же до пары надо переобъявить INPUT_MOUSE = 0.

Редактировалось 4 раз(а), последний 2025-04-01 13:08:21
карма: 26

1
Голосовали:tom-it
Ответов: 1120
Рейтинг: 80
#3: 2025-03-30 20:34:38 ЛС | профиль | цитата
Netspirit писал(а):
Вызов SendInput неправильный.

Inline не мой, найден на форуме. Внутренности еще не разглядывал, только объявил SendInput.
Спасибо. Буду разбираться.
карма: 2

0
Разработчик
Ответов: 26264
Рейтинг: 2140
#4: 2025-03-31 02:38:22 ЛС | профиль | цитата
tom-it писал(а):
Проверьте кто-нибудь у себя. А то у меня на штатном fpc пункт меню появляется в правом нижнем углу.

Да, есть такое. Проблема кроется вот здесь


   GetCursorPos(pos);

Эта функция в FPC выдает всегда одни и те же координаты в любом месте экрана. Как это побороть, я без понятия.

--- Добавлено в 2025-03-31 02:41:37

Самое интересное, что в компоненте MouseEvent эта функция работает нормально

--- Добавлено в 2025-03-31 02:44:17

Все же, это проблема в IC коде. После его отключения все работает правильно

Редактировалось 2 раз(а), последний 2025-03-31 02:44:17
карма: 22

0
4
Сообщение
...
Прикрепленные файлы
(файлы не залиты)