Авторизация

Логин: Пароль:
Регистрация Забыли свой пароль?

Лампочки (диоды) на клавиатуре

Страницы: 1
Лампочки (диоды) на клавиатуре
#1
01.12.2009 17:28:08
Подскажите, пожалуйста, как работать с диодами на клавиатуре?
 
 
#2
01.12.2009 18:13:52
Легко делается на WinApi.

Код
procedure ToggleNumLock;
var
   KeyState: TKeyboardState;
begin
   // Используй VK_CAPITAL для Caps Lock, VK_SCROLL для Num Lock

   GetKeyboardState(KeyState) ;

   // Эмулируем события клавиш (down + up) (нажать и отпустить)
   if (KeyState[VK_NUMLOCK] = 0) then
   begin
     Keybd_Event(VK_NUMLOCK, 1, KEYEVENTF_EXTENDEDKEY or 0, 0) ;
     Keybd_Event(VK_NUMLOCK, 1, KEYEVENTF_EXTENDEDKEY or KEYEVENTF_KEYUP, 0) ;
   end
   else
   begin
     Keybd_Event(VK_NUMLOCK, 0, KEYEVENTF_EXTENDEDKEY or 0, 0) ;
     Keybd_Event(VK_NUMLOCK, 0, KEYEVENTF_EXTENDEDKEY or KEYEVENTF_KEYUP, 0) ;
   end;
end;

Функция keybd_event эмулирет нажатие клавиши. Вызываем ее дважды для генерирования сообщений WM_KEYUP и WM_KEYDOWN.
 
 
#3
01.12.2009 18:36:32
Андрей,
Этот код годится только для Delphi. А мне нужно на чистом Pascal (Tubo Pascal) - прямая работа с контроллером
Изменено: Иван Седаков - 01.12.2009 18:36:58
 
 
#4
01.12.2009 20:52:27
На паскале это даже проще чем на delphi. Вот простая процедура она зажигает диоды на клавиатуре
Код
procedure Lights(State: Word);
begin
  Mem[Seg0040:$17] := State;
end;


А вот и список того каким должен быть state чтобы зажечь определенный диод
NUM = 32;
CAPS = 64;
SCROLL = 16;
 
 
#5
01.12.2009 21:22:48
Артём Кулинич,
А как зажечь 2 лампочки сразу?
 
 
#6
01.12.2009 21:30:18
Очевидно, что написать два раза Mem[...
Вот только код Артёма работать будет только под DOS, Win32 такие обращения с памятью не допускает.
 
 
#7
01.12.2009 21:34:24
Артём Кулинич,
Выдается такая ошибка
"Error 42: Error in expression."
 
 
#8
01.12.2009 21:45:09
Понятно. Код не полностью представлен. После Seg0040: должен идти $17
Не понимаю почему, эта часть скрылась.
Изменено: Артём Кулинич - 01.12.2009 21:48:30
 
 
#9
02.12.2009 17:37:53
Я знаю еще такой способ.
Включение Scroll
Код
Asm
  mov si,40h
  mov es,si
  mov si,17h
  mov al,00010000b
  mov es:[si],al
end;


Включение Caps
Код
Asm
  mov si,40h
  mov es,si
  mov si,17h
  mov al,01000000b
  mov es:[si],al
end;


Включение Num
Код
Asm
  mov si,40h
  mov es,si
  mov si,17h
  mov al,00100000b
  mov es:[si],al
end;
 
 
#10
02.12.2009 17:41:48
Цитата
Иван Седаков пишет:
А как зажечь 2 лампочки сразу?


Можно попробовать отправить сумму нескольких клавиш. При учете написанного выше сделать можно так.
Код
Lights(SCROLL+CAPS);
 
 
#11
02.12.2009 18:10:06
Этот модуль позволяет работать с диодами на клавиатуре. думаю по именам функция понятно их назначение, если нет - спрашивайте. Работает все очень просто. В качестве параметра и нужно использовать:
0 - погасить.
1 - зажечь.
2 - инвертировать.
Код
unit keyboard;
interface
uses DOS;

function  SimpleKeyPressed : boolean;
function  SimpleReadKey    : word;
function  SetNL  (b : byte) : boolean;
function  SetCL  (b : byte) : boolean;
function  SetSL  (b : byte) : boolean;
function  SetIns (b : byte) : boolean;
function  GetNL  : boolean;
function  GetCL  : boolean;
function  GetSL  : boolean;
function  GetIns : boolean;
function  SetNLCLSL (b : byte) : boolean;

implementation
{=====================}
function  SimpleKeyPressed: boolean;
var regs:registers;
begin
   regs.ah := $11;
   intr($16,regs);
   SimpleKeyPressed := (fzero and regs.flags) = 0
end;
{=====================}
function  SimpleReadKey: word;
var regs:registers;
begin
   regs.ah := $10;
   intr($16,regs);
   if regs.ax = 57357
   then SimpleReadKey := 7181
   else
      if regs.ax = 57354
      then SimpleReadKey := 7178
      else SimpleReadKey := regs.ax
end;
{=====================}
function  SetNL  (b : byte) : boolean;
var p : byte absolute $40:$17;
begin
   if b > 2
   then
   begin
      SetNL := false;
      exit
   end;
   SetNL := true;
   if b = 0
   then p := p and $DF;
   if b = 1
   then p := p or $20;
   if b = 2
   then p := p xor $20;
   SimpleKeyPressed
end;
{=====================}
function  SetCL  (b : byte) : boolean;
var p : byte absolute $40:$17;
begin
   if b > 2
   then
   begin
      SetCL := false;
      exit
   end;
   SetCL := true;
   if b = 0
   then p := p and $BF;
   if b = 1
   then p := p or $40;
   if b = 2
   then p := p xor $40;
   SimpleKeyPressed
end;
{=====================}
function  SetSL  (b : byte) : boolean;
var p : byte absolute $40:$17;
begin
   if b > 2
   then
   begin
      SetSL := false;
      exit
   end;
   SetSL := true;
   if b = 0
   then p := p and $EF;
   if b = 1
   then p := p or $10;
   if b = 2
   then p := p xor $10;
   SimpleKeyPressed
end;
{=====================}
function  SetIns (b : byte) : boolean;
var p : byte absolute $40:$17;
begin
   if b > 2
   then
   begin
      SetIns := false;
      exit
   end;
   SetIns := true;
   if b = 0
   then p := p and $7F;
   if b = 1
   then p := p or $80;
   if b = 2
   then p := p xor $80
end;
{=====================}
function  GetNL  : boolean;
var p,i : byte;
begin
   p := mem[$40:$17];
   for i := 1 to 5 do
      p := p div 2;
   GetNL := p mod 2 = 1
end;
{=====================}
function  GetCL  : boolean;
var p,i : byte;
begin
   p := mem[$40:$17];
   for i := 1 to 6 do
      p := p div 2;
   GetCL := p mod 2 = 1
end;
{=====================}
function  GetSL  : boolean;
var p,i : byte;
begin
   p := mem[$40:$17];
   for i := 1 to 4 do
      p := p div 2;
   GetSL := p mod 2 = 1
end;
{=====================}
function  GetIns : boolean;
var p,i : byte;
begin
   p := mem[$40:$17];
   for i := 1 to 7 do
      p := p div 2;
   GetIns := p mod 2 = 1
end;
{=====================}
function  SetNLCLSL (b : byte) : boolean;
var p : byte absolute $40:$17;
begin
   if b > 2
   then
   begin
      SetNLCLSL := false;
      exit
   end;
   SetNLCLSL := true;
   if b = 0
   then p := p and $8F;
   if b = 1
   then p := p or $70;
   if b = 2
   then p := p xor $70;
   SimpleKeyPressed
end;

begin
end.
Изменено: Иван Прокофьев - 02.12.2009 18:11:22
 
 
 
Страницы: 1
Читают тему (гостей: 1, пользователей: 0, из них скрытых: 0)