Visual Basic, .NET, ASP, VBScript
Новости | Примеры | Библиотека кодов | НеЧаВо | VBA | Справочник по VB | Справочник по WinAPI | ActiveX контролы | Статьи по VB | Мастерская разработчика | Форум VBNet | Яndex bar! | Голосование | Полезные программы | Магазин VBNet | Рассылка | Конкурсы | Юмор | Чат | Реклама на VBNet | Автора! | Ссылки | Бета-тестирование | Послать пример на сайт
 

   
   
     

Форум - Общий форум

Страница: 1 | 2 | 3 | 4 |

 

  Вопрос: ОткрытьКлавиатураДевайс Добавлено: 16.10.09 01:24  

Автор вопроса:  Winand | Web-сайт: winandfx.narod.ru
Это открытие девайса в плагине для Миранды. Плагин работает.
BOOL OpenKeyboardDevice()
{
int i = 0;
char aux1[MAX_PATH+1], aux2[MAX_PATH+1];

if (!bWindowsNT)
return TRUE;

do {
mir_snprintf(aux1, sizeof(aux1), "Kbd%d", i);
mir_snprintf(aux2, sizeof(aux2), "\\Device\\KeyboardClass%d", i);
DefineDosDevice(DDD_RAW_TARGET_PATH, aux1, aux2);

mir_snprintf(aux1, sizeof(aux1), "\\\\.\\Kbd%d", i);
hKbdDev[i] = CreateFile(aux1, GENERIC_WRITE, 0, NULL, OPEN_EXISTING, 0, NULL);

} while (hKbdDev[i] != INVALID_HANDLE_VALUE && ++i < MAX_KBDHANDLES);

return hKbdDev[0] != INVALID_HANDLE_VALUE;
}

Это открытие клавиатуры у меня. CreateFile возвращает -1
Private Declare Function CreateFile Lib "kernel32.dll" Alias "CreateFileA" (ByVal lpFileName As String, ByVal dwDesiredAccess As Long, ByVal dwShareMode As Long, ByRef lpSecurityAttributes As Long, ByVal dwCreationDisposition As Long, ByVal dwFlagsAndAttributes As Long, ByVal hTemplateFile As Long) As Long
Private Const OPEN_EXISTING As Long = 3
Private Const GENERIC_WRITE As Long = &H40000000
Private Function OpenKeyboardDevice() As Long
    If DefineDosDevice(DDD_RAW_TARGET_PATH, "Kbd", "\\Device\\KeyboardClass0") = 0 Then Exit Function
    OpenKeyboardDevice = CreateFile("\\\\.\\Kbd", GENERIC_WRITE, 0, ByVal 0, OPEN_EXISTING, 0, 0)
End Function

Ответить

  Ответы Всего ответов: 50  

Номер ответа: 1
Автор ответа:
 Winand



Вопросов: 87
Ответов: 2795
  Web-сайт: winandfx.narod.ru
 Профиль | | #1 		Добавлено: 16.10.09 03:03
Ладно, я все равно сообразил быстрее) Тем не менее, я - идиот. Двойные и 4ные слеши - это тонкости с++, а я и забыл. Ну а бейсике надо писать одинарные и двойные.

А зачем это всё надо? - спросите вы меня. Я подумал, а не приделать ли мне светомузыку к Аудике. Приделать пока не приделал, но работать с лампочками научился. Главное преимущество перед большинством других примеров - состояния клавиш капс, нам и скролл не трогаются.
  1. Option Explicit
  2. Private Declare Function DeviceIoControl Lib "kernel32.dll" (ByVal hDevice As Long, ByVal dwIoControlCode As Long, ByRef lpInBuffer As Any, ByVal nInBufferSize As Long, ByRef lpOutBuffer As Any, ByVal nOutBufferSize As Long, ByRef lpBytesReturned As Long, ByRef lpOverlapped As Long) As Long
  3. Private Type KEYBOARD_INDICATOR_PARAMETERS
  4.     UnitId As Integer
  5.     LedFlags As Integer
  6. End Type
  7. Private Const IOCTL_KEYBOARD_QUERY_INDICATORS As Long = &HB0040
  8. Private Const IOCTL_KEYBOARD_SET_INDICATORS As Long = &HB0008
  9. Private Declare Function DefineDosDevice Lib "kernel32.dll" Alias "DefineDosDeviceA" (ByVal dwFlags As Long, ByVal lpDeviceName As String, ByVal lpTargetPath As String) As Long
  10. Private Declare Function CreateFile Lib "Kernel32" Alias "CreateFileA" (ByVal lpFileName As String, ByVal dwDesiredAccess As Long, ByVal dwShareMode As Long, ByVal lpSecurityAttributes As Long, ByVal dwCreationDisposition As Long, ByVal dwFlagsAndAttributes As Long, ByVal hTemplateFile As Long) As Long
  11. Private Const OPEN_EXISTING As Long = 3
  12. Private Const GENERIC_WRITE As Long = &H40000000
  13. Private Const DDD_RAW_TARGET_PATH As Long = &H1
  14. Private Const DDD_REMOVE_DEFINITION As Long = &H2
  15. Private Declare Function CloseHandle Lib "kernel32.dll" (ByVal hObject As Long) As Long
  16. Private Declare Function GetKeyboardState Lib "user32" (pbKeyState As Byte) As Long
  17. Private Const VK_NUMLOCK = &H90 'NumLock
  18. Private Const VK_CAPITAL = &H14 'CapsLock
  19. Private Const VK_SCROLL = &H91  'ScrollLock
  20.  
  21. Private kbd As Long
  22.  
  23. Private Sub Form_Load()
  24.     Dim scrl As Boolean, num As Boolean, caps As Boolean
  25.     kbd = OpenKeyboardDevice
  26.     If kbd <> 0 Then
  27.         setLEDs kbd, False, True, False
  28.         Timer1.Enabled = True
  29.     Else
  30.         MsgBox "Can't open keyboard device!"
  31.         End
  32.     End If
  33. End Sub
  34.  
  35. 'Set real LED states (according to key states)
  36. Private Function restoreLEDs(ByVal hKbdDev As Long) As Boolean
  37.     Dim states(255) As Byte, scrl As Boolean, num As Boolean, caps As Boolean
  38.     GetKeyboardState states(0)
  39.     scrl = states(VK_SCROLL)
  40.     num = states(VK_NUMLOCK)
  41.     caps = states(VK_CAPITAL)
  42.     restoreLEDs = setLEDs(hKbdDev, scrl, num, caps)
  43. End Function
  44.  
  45. Private Function setLEDs(ByVal hKbdDev As Long, ByVal scrl As Boolean, ByVal num As Boolean, ByVal caps As Boolean) As Boolean
  46.     Dim buf As KEYBOARD_INDICATOR_PARAMETERS
  47.     Dim ret As Long 'return length
  48.     buf.LedFlags = IIf(scrl, 1, 0) Or IIf(num, 2, 0) Or IIf(caps, 4, 0)
  49.     If DeviceIoControl(hKbdDev, IOCTL_KEYBOARD_SET_INDICATORS, buf, Len(buf), _
  50.         Null, 0, ret, ByVal 0) <> 0 Then setLEDs = True
  51. End Function
  52.  
  53. Private Function queryLEDs(ByVal hKbdDev As Long, ByRef scrl As Boolean, ByRef num As Boolean, ByRef caps As Boolean) As Boolean
  54.     Dim buf As KEYBOARD_INDICATOR_PARAMETERS    ' Input buffer for DeviceIoControl
  55.     Dim ret As Long 'return length
  56.     If DeviceIoControl(hKbdDev, IOCTL_KEYBOARD_QUERY_INDICATORS, Null, 0, _
  57.         buf, Len(buf), ret, ByVal 0) <> 0 Then queryLEDs = True
  58.     scrl = (buf.LedFlags And 1)
  59.     num = (buf.LedFlags And 2)
  60.     caps = (buf.LedFlags And 4)
  61. End Function
  62.  
  63. Private Function OpenKeyboardDevice() As Long
  64.     If DefineDosDevice(DDD_RAW_TARGET_PATH, "Kbd", "\Device\KeyboardClass0") = 0 Then Exit Function
  65.     OpenKeyboardDevice = CreateFile("\\.\Kbd", GENERIC_WRITE, 0, ByVal 0, OPEN_EXISTING, 0, 0)
  66. End Function
  67.  
  68. Private Function CloseKeyboardDevice(ByVal hndKbdDev As Long) As Long
  69. 'DefineDosDevice(DDD_REMOVE_DEFINITION) возвращает всегда ноль. Пришлось закомментить=)
  70. '    If DefineDosDevice(DDD_REMOVE_DEFINITION, "Kbd", "") = 0 Then Exit Function
  71.     CloseKeyboardDevice = CloseHandle(hndKbdDev)
  72. End Function
  73.  
  74. Private Sub Form_Unload(Cancel As Integer)
  75.     restoreLEDs kbd
  76.     CloseKeyboardDevice kbd
  77. End Sub
  78.  
  79. Private Sub Timer1_Timer()
  80.     Dim scrl As Boolean, num As Boolean, caps As Boolean
  81.     Dim scrl1 As Boolean, num1 As Boolean, caps1 As Boolean
  82.     queryLEDs kbd, scrl, num, caps
  83.     num1 = IIf(scrl, True, False) 'After scrolllock
  84.     caps1 = IIf(num, True, False) 'After numlock
  85.     scrl1 = IIf(caps, True, False) 'After capslock
  86.     setLEDs kbd, scrl1, num1, caps1
  87. End Sub

Ответить

Номер ответа: 2
Автор ответа:
 Smith



ICQ: adamis@list.ru 

Вопросов: 153
Ответов: 3632
  Профиль | | #2 Добавлено: 16.10.09 14:55
Три лампочки какраз для низких, средних и высоких частот.
Елиб ещё управлять их яркостью, хотябы пару градаций сделать.

Ответить

Номер ответа: 3
Автор ответа:
 GDK



Вопросов: 13
Ответов: 348
  Профиль | | #3 Добавлено: 16.10.09 16:03
Просто ради интереса: О чём здесь речь? Ну что есть миранда нашёл - программа для общения через интернет типа ICQ. А причём здесьсветомузыка, девайс и клава? И какими лампочками можно управлять? Аудике - аудиосистема???

Ответить

Номер ответа: 4
Автор ответа:
 Smith



ICQ: adamis@list.ru 

Вопросов: 153
Ответов: 3632
  Профиль | | #4 Добавлено: 16.10.09 16:27
Ну какими лампочками на клаве можно управлять под музыку???
GDK на обычных клавах есть Нам Лок, Капс и Скролл Лок, три светодиода и миранда ими управляет.
Винанд подглядел там как это делается и хочет сделать
импровизированную светомузыку для своего плеера.
Обычно лампочки одного цвета поэтому Цветомузыка неполучится :-), но всёравно весьма оригинально.

Ответить

Номер ответа: 5
Автор ответа:
 Smith



ICQ: adamis@list.ru 

Вопросов: 153
Ответов: 3632
  Профиль | | #5 Добавлено: 16.10.09 16:38
Кстати Winаnd не на всех клавах они есть, у меня беспроводная без индикации.

Ответить

Номер ответа: 6
Автор ответа:
 Winand



Вопросов: 87
Ответов: 2795
  Web-сайт: winandfx.narod.ru
 Профиль | | #6 		Добавлено: 17.10.09 12:20
Smith, ну блин, если нет ЛЕДов - это железная проблема) мы не при чем)
Кстати я думаю, всё таки можно сделать мигание в такт. Только нужно узнать как это делать=)
GDK, у Miranda есть плагин, который мигает лампочками на разных событиях. Типа, когда сообщение приходит

Ответить

Номер ответа: 7
Автор ответа:
 Smith



ICQ: adamis@list.ru 

Вопросов: 153
Ответов: 3632
  Профиль | | #7 Добавлено: 17.10.09 16:44
Твой спектрограф можно доработать, чтоб получить с него три переменные (низкие, средние и высокие частоты) со значениями 0, 1(~50%) и 2(~100% уровня)?
Элементарно совместить это с частотным управлением яркостью и получится ништяк.

Ответить

Номер ответа: 8
Автор ответа:
 Sharp


Лидер форума

ICQ: 216865379 

Вопросов: 106
Ответов: 9979
  Web-сайт: sharpc.livejournal.com
 Профиль | | #8 		Добавлено: 17.10.09 22:32
Если лампочки достаточно быстро переключаются, можно управлять яркостью, моргая с разными паузами. В такт музыке можно попасть, анализируя низкочастотные гармоники (1-5 Гц).

Ответить

Номер ответа: 9
Автор ответа:
 Smith



ICQ: adamis@list.ru 

Вопросов: 153
Ответов: 3632
  Профиль | | #9 Добавлено: 18.10.09 01:51
Дык я вроде уже не раз об этом написал, а если эта графическая дрыгалка :) будет немного доделана, то и ананизировать :) ничего не придется, можно будет связать напрямую.

Ответить

Номер ответа: 10
Автор ответа:
 Winand



Вопросов: 87
Ответов: 2795
  Web-сайт: winandfx.narod.ru
 Профиль | | #10 		Добавлено: 18.10.09 18:27
Зацените) и скажите, если что не правильно. Кстати частотное управление - вещь)
  1. 'modSpectrum.bas
  2.  
  3. Private Function freqBrightness(ByVal v As Single, ByVal led As Integer) As Boolean
  4.     Static leds(2) As Integer
  5.     inc leds(led) 'инкремент
  6.     If leds(led) * v >= 1 Then
  7.         leds(led) = 0
  8.         freqBrightness = True
  9.     End If
  10. End Function
  11. '............
  12. 'Это в таймере
  13.         If LEDControl Then
  14.             Dim d(2) As Single, z As Integer, l As Integer
  15.             For z = 1 To 341
  16.                 d(0) = d(0) + fft(z)
  17.                 d(1) = d(1) + fft(z + 341)
  18.                 d(2) = d(2) + fft(z + 682)
  19.             Next z
  20.             Call setLEDs(freqBrightness(d(2), 2), _
  21.                         freqBrightness(d(0), 0), _
  22.                         freqBrightness(d(1), 1))
  23.         End If

В fft() содержится инфа о частотах
When requesting FFT data, floating-point values ranging from 0 to 1 are returned. Only the first half of the FFT is useful, so that's what BASS returns. For example, with a 2048 sample FFT, it will return 1024 values; the 1st value being the DC component, the 2nd being the amplitude at 1/2048 of the channel's sample rate, then the amplitude at 2/2048, 3/2048, etc...

http://slil.ru/28093821 бинарник и либы
http://slil.ru/28093824 сорсы

Ответить

Номер ответа: 11
Автор ответа:
 Winand



Вопросов: 87
Ответов: 2795
  Web-сайт: winandfx.narod.ru
 Профиль | | #11 		Добавлено: 18.10.09 18:38
Хотя секундочку.. это ж хрень. Я беру 1023 значения от 0 до 1 (обычно около нуля), складываю 1--341, 342--682, 683--1023

Ответить

Номер ответа: 12
Автор ответа:
 Winand



Вопросов: 87
Ответов: 2795
  Web-сайт: winandfx.narod.ru
 Профиль | | #12 		Добавлено: 18.10.09 18:41
Хотел объяснить как работает, но лень до конца расписывать) И клава подглючивает, если печатать во время мигания. Не знаю, почему

Ответить

Номер ответа: 13
Автор ответа:
 Smith



ICQ: adamis@list.ru 

Вопросов: 153
Ответов: 3632
  Профиль | | #13 Добавлено: 18.10.09 18:49
А где Add files playlist?
Пришлось файлы в лист мышкой тащить.

Ответить

Номер ответа: 14
Автор ответа:
 Smith



ICQ: adamis@list.ru 

Вопросов: 153
Ответов: 3632
  Профиль | | #14 Добавлено: 18.10.09 18:56
Щас с ЕееПисюхи, тут ледов нет, но за спектрограф зачёт!
Когда играет печатать мешает, некоторые буквы выдалбливать приходтся :)

Ответить

Номер ответа: 15
Автор ответа:
 Winand



Вопросов: 87
Ответов: 2795
  Web-сайт: winandfx.narod.ru
 Профиль | | #15 		Добавлено: 18.10.09 19:07
Smith, думаю надо перед перелючением ледов проверять не нажаты ли юзером клавиши.
Add files временно сломано, потому что надо юникодную версию открывашки файлов делать. А это муторно)
Типа чейнджлог - http://pastebin.mozilla-russia.org/102156

Ответить

Страница: 1 | 2 | 3 | 4 |

Поиск по форуму



© Copyright 2002-2011 VBNet.RU | Пишите нам