Клавиатура и мышь

[Stargazer44]

Не пойму, что здесь не так.
Не работают совместно клавиатура и мышь:
нажатие кнопок мыши цикл прерывает, а на клавиатуру программа не реагирует (кроме Ctrl-Break)
FPC 2.6.0 , Windows-7 x64

Код: Выделить всё

program KeybMous;

uses crt,mouse;

var
  me : TMouseEvent;
  ch : char;

begin
  InitMouse;

  repeat

    write(chr(random(224)+32),#8);

    if keypressed then begin
      ch:=readkey;
      if ch=#0 then ch:=readkey;
      writeln('Keyboard  ',ord(ch));
      break;
    end;

    if PollMouseEvent(me) then begin
      GetMouseEvent(me);
      if me.Action=MouseActionDown then begin
        writeln('Mouse     ',me.Buttons);
        break;
      end;
    end;

  until false;

  DoneMouse;

end.


[Vadim]

У меня Ваш код работает. К примеру, нажимаю клавишу ESC, на экране пишет "Keyboard 27" и программа останавливается. Правда у меня компилятор 2.6.2 и W7_x32. На W2008R2 тоже работает.

[SSerge]

FPC 2.7.1 x32 и x64
Windows 7 x64 оба варианта работают. С оговоркой. Но тут уж как написали, так оно и действует.
То есть, если кратковременно ткнуть в кнопку - то как повезёт. Если кнопку держать долго - срабатывает.

Добавлено спустя 4 минуты 33 секунды:
Хотите, чтобы срабатывало с первого раза, уберите это безобразие:

Код: Выделить всё

write(chr(random(224)+32),#8);

...Ибо нельзя с одним и тем же логическим устройством типа консоли работать так, чтобы флудить в него постоянным потоком символов и одновременно из него же читать.

[Stargazer44]

FPC 2.7.1 x32 и x64
Windows 7 x64 оба варианта работают. С оговоркой. Но тут уж как написали, так оно и действует.
То есть, если кратковременно ткнуть в кнопку - то как повезёт. Если кнопку держать долго - срабатывает.
Хотите, чтобы срабатывало с первого раза, уберите это безобразие:

Код: Выделить всё

write(chr(random(224)+32),#8);

...Ибо нельзя с одним и тем же логическим устройством типа консоли работать так, чтобы флудить в него постоянным потоком символов и одновременно из него же читать.

Хм, тогда объясню задачу конкретно:
В процедуру передаётся время в секундах; она "включает обратный отсчёт" - пишет на экране оставшееся время - и одновременно проверяет нажатие кнопок (и на клавиатуре, и на мыши). И если какая-нибудь кнопка нажата, прерывает работу, возвращая код нажатой кнопки. Если время истекло, возвращается нуль.
Подскажите, пожалуйста, каким образом мне организовать одновременно и вывод на экран (в консоль), и "слушание" кнопок.

[SSerge]

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

Если вывод производите средствами консоли, то перед вводом необходимо поставить паузу (как уж придумаете, скажем, не на каждом цикле опрашивать клавиатуру что ли, или что лучше - не на каждом цикле выводить символы (например, прочитать таймер, запомнить его значение, и вывод на экран делать не быстрее раза в секунду, или через другой стабильный промежуток). Или использовать для вывода не-консольные средства. Ранее в такого рода задачах можно было пользоваться прямой адресацией видеопамяти или функциями BIOS, сработает ли это для консоли 64х, не берусь сказать.

Проблема скорее всего возникает из-за переполнения буфера вывода. При таком переполнении консоль сбрасывает оба своих буфера, и ввод и вывод.

[Stargazer44]

Если вывод производите средствами консоли, то перед вводом необходимо поставить паузу.

Уфф. Пробовал - не получилось.

Или использовать для вывода не-консольные средства.

А вот тут, пожалуйста, поподробнее...

[Stargazer44]

Ура! У меня получилось!!!
Огромное спасибо В. А. Соковикову за перевод документации: http://www.vsokovikov.narod.ru/New_MSDN_API/Console/ogl_con.htm
Благодаря ей, я написал процедуру, которая прекрасно заменяет собой crt'шные readkey и keypressed, ещё и мышь опрашивает:

Код: Выделить всё

uses windows;

// Опрос кнопок клавиатуры и мыши.
procedure ReadKeys(var KeyCode, ControlKeyState :byte);
{ Возвращаемые значения:
KeyCode - код нажатой кнопки:
  0      - обычные (не управляющие) кнопки НЕ нажаты;
  1..7   - кнопки мыши: 1-левая; 2-правая; 3-средняя; 4..7-прочие кнопки мыши;
  8..255 - кнопки клавиатуры (Виртуальные коды клавиш)
ControlKeyState - состояние управляющих кнопок (побитно):
  0 - Правая кнопка ALT   нажата
  1 - Левая  кнопка ALT   нажата
  2 - Правая кнопка CTRL  нажата
  3 - Левая  кнопка CTRL  нажата
  4 - Любая  кнопка SHIFT нажата
  5 - Индикатор NUM LOCK    включён
  6 - Индикатор SCROLL LOCK включён
  7 - Индикатор CAPS LOCK   включён }
const control_keys=[16..20,44,91..93,144,145,160..165]; //Коды управляющих и необрабатываемых кнопок
var ih:hwnd;         // дескриптор ввода
    n,w:dword;       // число событий, состояние кнопок
    IR:INPUT_RECORD; // буфер данных
begin {ReadKeys}
  KeyCode:=0; ControlKeyState:=$FF;
  ih:=GetStdHandle(STD_INPUT_HANDLE);
  GetNumberOfConsoleInputEvents(ih,@n);
  while n>0 do begin
    ReadConsoleInput(ih,@IR,1,@w);
    if IR.EventType = 1 then begin // Обработка событий клавиатуры
      if not (IR.Event.KeyEvent.wVirtualKeyCode in control_keys) and IR.Event.KeyEvent.bKeyDown then begin
        KeyCode:=IR.Event.KeyEvent.wVirtualKeyCode and $FF;
        ControlKeyState:=IR.Event.KeyEvent.dwControlKeyState and $FF;
        break;
      end;
    end else
    if IR.EventType = 2 then begin // Обработка событий мыши
      w := IR.Event.MouseEvent.dwButtonState and $7F;
      while w>0 do begin
        inc(KeyCode);
        if odd(w) then break;
        w := w shr 1;
      end;
      if KeyCode>0 then begin
        ControlKeyState:=IR.Event.MouseEvent.dwControlKeyState and $FF;
        break;
      end;
    end;
    dec(n);
  end; {while n>0}
  if ControlKeyState=$FF then begin // Просмотр состояния управляющих кнопок
    if GetKeyState(VK_RMENU)    and $80 = 0 then ControlKeyState := ControlKeyState xor $01;
    if GetKeyState(VK_LMENU)    and $80 = 0 then ControlKeyState := ControlKeyState xor $02;
    if GetKeyState(VK_RCONTROL) and $80 = 0 then ControlKeyState := ControlKeyState xor $04;
    if GetKeyState(VK_LCONTROL) and $80 = 0 then ControlKeyState := ControlKeyState xor $08;
    if GetKeyState(VK_SHIFT)    and $80 = 0 then ControlKeyState := ControlKeyState xor $10;
    if GetKeyState(VK_NUMLOCK)  and $01 = 0 then ControlKeyState := ControlKeyState xor $20;
    if GetKeyState(VK_SCROLL)   and $01 = 0 then ControlKeyState := ControlKeyState xor $40;
    if GetKeyState(VK_CAPITAL)  and $01 = 0 then ControlKeyState := ControlKeyState xor $80;
  end;
end; {ReadKeys}


...Ибо нельзя с одним и тем же логическим устройством типа консоли работать так, чтобы флудить в него постоянным потоком символов и одновременно из него же читать.

Как оказалось, очень даже можно

[bormant]

ih:=GetStdHandle(STD_INPUT_HANDLE);

Хочу обратить внимание на пару цитат оттуда же:

Однако функция SetStdHandle может переназначать стандартные дескрипторы, изменяя дескриптор, связанный с STDIN, STDOUT или STDERR. Поскольку стандартные дескрипторы родительского элемента наследуются любым дочерним процессом, последующие вызовы к GetStdHandle возвращают переназначенный дескриптор. Дескриптор, возвращенный функцией GetStdHandle, по этой причине может сослаться на что-либо другое, а не на консольный ввод - вывод (I/O).
...
Функция CreateFile дает возможность процессу получить дескриптор для буфера вводимых данных его консоли и активного экранного буфера, даже если STDIN и STDOUT были переназначены. Чтобы открыть дескриптор буфера вводимых данных консоли, при вызове функции CreateFile установите значение CONIN$. Чтобы открыть дескриптор активного экранного буфера консоли, при вызове CreateFile установите значение CONOUT$.

И, возможно, есть смысл один раз получить дескриптор консоли и не дёргать при каждом обращении GetStdHandle()/CreateFile().