Отличный пример, если б кто-то еще сделал USB LED часы(передача на 7-ми сегментный 4-ох разрядный LED индикатор)...Ну что-бы время всегда видно было, ну или температуру видеокарты/процессора...
USB часы
Сообщений 1 страница 27 из 27
Поделиться201.08.2012 01:58:04
У нас Меги даже на радиорынке продают, только цену гнут бешеную, у других слышал в 2 раза дешевле есть... но если есть где-то недалеко подобное - спроси...
А вот с PureBasic буду разбираться, мне если чесно Microsoft Visual Studio 2008 (VB и C#) более нравятся, ну да ладно...
Отредактировано ALEX_GREEN (01.08.2012 01:59:49)
Поделиться301.08.2012 11:18:52
Не работает только там, где нет .NET Framework-a. Все игры, новые программы написаны там!!!
Поделиться401.08.2012 11:50:06
мне если чесно Microsoft Visual Studio 2008 (VB и C#) более нравятся
Пишите на чем вам удобно.
Из C# тоже можно работать с HID устройствами.
Поделиться501.08.2012 17:22:43
Я с VB 6.0 начинал, так-же делал, теперь пишу на VB в Студии 2008 года, там удобнее, да и на фреймворке 2.0, который есть на 7-ке. Иногда на С#, но это скорее обучение, чем творчество... Ладно, пора завязывать эту тему, буду пытаться сделать USB часы, но не уверен, что получится... Детали уже купил))
Поделиться601.08.2012 17:53:42
USB LED часы
буду пытаться сделать USB часы, но не уверен, что получится... Детали уже купил
Лучше использовать LCD индикатор, типа WH1602, потому что если в часах использовать семисигментники, то скорее всего динамическая индикация будет "дерганая" из-за прерываний от USB.
Поделиться701.08.2012 19:13:29
Если речь идет об электрических колебаниях, попробуйте фильтр с конденсаторами
Читайте. http://radiokot.ru/start/mcu_fpga/avr/15/
http://ru.wikipedia.org/wiki/%CF%F0%E5% … 0%ED%E8%E5
Поделиться802.08.2012 19:23:31
Буду пробовать пока без кондентсаторов(мысль была об этом, но собирал другие схемы с динамической индикацией - небольшое затемнение было только тогда, когда шел опрос температурного датчика, но еле заметное, прошивка не моя, поэтому ничего в ней я не понял, кроме того, как исправить глюк с отображением отрицательной температуры), а саму процедуру отображения вижу так: по USB передается 32 бита, по 8 на каждый сегмент, отображение идет в цикле, и не связанно с USB, каждая часть сегмента сверяется со своим битом, A с 1, B - 2, C-3 ... точка с 8. (с 9 до 16 - 2 сегмент и т.д.). Обновление происходит раз в минуту, когда меняется время соответственно... Программу подредактировал под себя(Источник), плату развел, теперь жду пока вытравится...
Отредактировано ALEX_GREEN (02.08.2012 19:25:31)
Поделиться902.08.2012 20:50:45
Комп регулярно (каждые 10 мс) "общается" с устройством даже если нет передачи или приема данных.
Поэтому нужно учитывать что 100 раз в секунду, будут возникать прерывания от USB. Запрещать прерывания нельзя, иначе произойдет сбой.
Поделиться1002.08.2012 21:41:05
Ясно, я просто думал, что прерывания происходят только тогда, когда идет передача данных, ну ладно, сперва попробую, думаю это не сильно заметно будет, а если заметно, то емкость в 10 мкф думаю все исправит... может вообще ничего не выйдет, а может все получится))
Поделиться1102.08.2012 22:09:03
емкость в 10 мкф
Что она исправит?
Поделиться1202.08.2012 22:16:36
индикатор будет мигать, но все-же будет отображаться или я не правильно понял? Если к каждому выводу (от A до H (точки)) подкл. параллельно кондентсатор, то его заряда должно хватить на компенсацию мигания, тоесть прийдется добавить 8 кондентсаторов.
Поделиться1302.08.2012 22:31:15
Тогда на индикаторе будут восьмерки.
Смотрите, индикация динамическая и выводы сегментов A - H будут общими для всех разрядов.
Поделиться1402.08.2012 22:35:02
Чет я совсем запутался... да, вы правы. Бред написал.
Отредактировано ALEX_GREEN (02.08.2012 22:35:24)
Поделиться1503.08.2012 18:17:54
Динамическая индикация работает отлично, без мерцания, но вот что я не пойму, так это:
как передать 4 байта на МК, как вообще передача идет, что означает 2-ка в "_usb_rx_buffer(2)", если это размер буфера в байтах, то можно ли его заменить на 4?
Программа на данный момент спокойно понимает:
Dim S As String * 32
S = "01100000110110111111001001100110" ' Отображаем "12.34"
Как правильно отослать эту строку с компьютера на МК, так, что-бы результат был String.
Код:$regfile = "m8def.dat" $crystal = 12000000 $hwstack = 40 $swstack = 40 $framesize = 50 $include "USB\USB_Config.bas" $include "USB\Const_swusb-includes.bas" Dim Buttons_current As Byte Dim Buttons_last As Byte Dim S As String * 32 Dim S2 As String * 1 Const Waitconst = 1 Declare Sub Ledoff Config Portb = Output Config Portc = Output Config Portd.1 = Input ' Разрешаем прерывания. Enable Interrupts Do Call Usb_refresh() ' Получены данные от компьютера. If _usb_status._usb_rxc = 1 Then If _usb_status._usb_setup = 1 Then ' Обработка системных сообщений нулевой конечной точки. Call Usb_processsetup(_usb_tx_status) Elseif _usb_status._usb_endp1 = 1 Then ' Пришёл пакет данных из компьютера в 1 конечную точку. Toggle _usb_rx_buffer(4) S = Bin(_usb_rx_buffer(4)) End If ' Признак готовности принять следующий пакет данных. _usb_status._usb_rtr = 1 _usb_status._usb_rxc = 0 End If S = "01100000110110111111001001100110" ' Отображаем "12.34" для примера Ledoff '********************* N1 Portc.5 = 1 S2 = Mid(s , 1 , 1) If S2 = "1" Then Portb.4 = 0 '1-A S2 = Mid(s , 2 , 1) If S2 = "1" Then Portb.0 = 0 '1-B S2 = Mid(s , 3 , 1) If S2 = "1" Then Portc.1 = 0 '1-C S2 = Mid(s , 4 , 1) If S2 = "1" Then Portc.3 = 0 '1-D S2 = Mid(s , 5 , 1) If S2 = "1" Then Portc.4 = 0 '1-E S2 = Mid(s , 6 , 1) If S2 = "1" Then Portb.3 = 0 '1-F S2 = Mid(s , 7 , 1) If S2 = "1" Then Portc.0 = 0 '1-G S2 = Mid(s , 8 , 1) If S2 = "1" Then Portc.2 = 0 '1-H Waitms Waitconst Portc.5 = 0 '********************* N2 Ledoff Portb.2 = 1 S2 = Mid(s , 9 , 1) If S2 = "1" Then Portb.4 = 0 '1-A S2 = Mid(s , 10 , 1) If S2 = "1" Then Portb.0 = 0 '1-B S2 = Mid(s , 11 , 1) If S2 = "1" Then Portc.1 = 0 '1-C S2 = Mid(s , 12 , 1) If S2 = "1" Then Portc.3 = 0 '1-D S2 = Mid(s , 13 , 1) If S2 = "1" Then Portc.4 = 0 '1-E S2 = Mid(s , 14 , 1) If S2 = "1" Then Portb.3 = 0 '1-F S2 = Mid(s , 15 , 1) If S2 = "1" Then Portc.0 = 0 '1-G S2 = Mid(s , 16 , 1) If S2 = "1" Then Portc.2 = 0 '1-H Waitms Waitconst Portb.2 = 0 '********************* N3 Ledoff Portb.1 = 1 S2 = Mid(s , 17 , 1) If S2 = "1" Then Portb.4 = 0 '1-A S2 = Mid(s , 18 , 1) If S2 = "1" Then Portb.0 = 0 '1-B S2 = Mid(s , 19 , 1) If S2 = "1" Then Portc.1 = 0 '1-C S2 = Mid(s , 20 , 1) If S2 = "1" Then Portc.3 = 0 '1-D S2 = Mid(s , 21 , 1) If S2 = "1" Then Portc.4 = 0 '1-E S2 = Mid(s , 22 , 1) If S2 = "1" Then Portb.3 = 0 '1-F S2 = Mid(s , 23 , 1) If S2 = "1" Then Portc.0 = 0 '1-G S2 = Mid(s , 24 , 1) If S2 = "1" Then Portc.2 = 0 '1-H Waitms Waitconst Portb.1 = 0 '********************* N2 Ledoff Portb.5 = 1 S2 = Mid(s , 25 , 1) If S2 = "1" Then Portb.4 = 0 '1-A S2 = Mid(s , 26 , 1) If S2 = "1" Then Portb.0 = 0 '1-B S2 = Mid(s , 27 , 1) If S2 = "1" Then Portc.1 = 0 '1-C S2 = Mid(s , 28 , 1) If S2 = "1" Then Portc.3 = 0 '1-D S2 = Mid(s , 29 , 1) If S2 = "1" Then Portc.4 = 0 '1-E S2 = Mid(s , 30 , 1) If S2 = "1" Then Portb.3 = 0 '1-F S2 = Mid(s , 31 , 1) If S2 = "1" Then Portc.0 = 0 '1-G S2 = Mid(s , 32 , 1) If S2 = "1" Then Portc.2 = 0 '1-H Waitms Waitconst Portb.5 = 0 Buttons_current = Pind.1 Buttons_current = Buttons_current And 1 If Buttons_current <> Buttons_last Then If _usb_tx_status2._usb_txc = 1 Then Buttons_last = Buttons_current If Buttons_current <> 0 Then _usb_tx_buffer2(2) = 40 Else _usb_tx_buffer2(2) = 20 End If Call Usb_send(_usb_tx_status2 , 1) ' Передача в компьютер одного байта. End If End If Loop Sub Ledoff Portb.4 = 1 Portb.0 = 1 Portc.1 = 1 Portc.3 = 1 Portc.4 = 1 Portb.3 = 1 Portc.0 = 1 Portc.2 = 1 Portc.5 = 0 Portb.2 = 0 Portb.1 = 0 Portb.5 = 0 End Sub End $include "USB\USB_Descriptor.bas" $include "USB\USB_Subroutines.bas"
Поделиться1603.08.2012 18:51:55
Так работать не будет.
Нельзя использовать задержки в цикле программы, иначе нарушится работа USB.
Нужно их убрать из кода.
Вообще, динамическую индикацию лучше организовать по другому, примерно так. http://pure-basic.narod.ru/forum/bascom … mo_Led.rar
Только вызывать подпрограмму Dinam нужно не по прерываниям таймера, а в главном цикле программы.
В массиве Dinaminfo() должны быть 4 байта, выводимые на индикатор.
как передать 4 байта на МК, как вообще передача идет
Посмотрите статью в журнале "Радио" 2011 № 4, в которой написано как производится обмен с USB HID устройствами.
что означает 2-ка в "_usb_rx_buffer(2)", если это размер буфера в байтах, то можно ли его заменить на 4?
Это индекс массива в котором хранится принятая информация.
Чтобы увеличить число принимаемых данных до 4 байта за посылку, нужно найти в файле "USB\USB_Descriptor.bas"
Дескриптор сообщения (репорта), описывающий тип HID устройства и его характеристики
Найти там Описание конечной точки, типа Output и в строке:
Data &H95 , &H01
заменить 01 на 04.
Поделиться1703.08.2012 18:57:03
Огромнейшее спасибо, буду пробовать)) (Это мой 3-й проект на МК, а прошивка - первая...)
Поделиться1803.08.2012 19:15:04
Тогда еще посмотрите статьи в журналах "Радио" 2011, №10 и №11.
В них рассматривается разработка микроконтроллерных USB устройств.
Поделиться1903.08.2012 19:39:23
Спс, уже смотрел, нашел в ReadMe.txt))
Поделиться2004.08.2012 08:44:40
Устройство работает, принимает данные, но вот только опять проблемма, при передаче чего-либо неправильно отображается 1-й разряд на индикаторе, например:
12.34 будет -2.34, а test. будет -.test. (точки учитываются)
Ожидание в 1 миллисекунду все-же оставил, проблемм не заметил, если убрать, то индикация некоторых сегментов получается почти незаметной, на отображение первого символа не влияет. Индикацию тоже пока оставил в цикле прерываний. Да и 3 последующих разряда спокойно отображаются, а 1-й - нет(( Может нельзя использовать _usb_rx_buffer(5)?
Уже не знаю где проблемма, вот код программы МК и для ПК:
$regfile = "m8def.dat"
$crystal = 12000000$hwstack = 40
$swstack = 40
$framesize = 50$include "USB\USB_Config.bas"
$include "USB\Const_swusb-includes.bas"Dim Buttons_current As Byte
Dim Buttons_last As Byte
Dim S As String * 32
Dim S2 As String * 1
Dim A(4) As Byte
Const Waitconst = 1
Declare Sub LedoffConfig Portb = Output
Config Portc = Output
Config Portd.1 = Input' Разрешаем прерывания.
Enable InterruptsDo
Call Usb_refresh()
' Получены данные от компьютера.
If _usb_status._usb_rxc = 1 Then
If _usb_status._usb_setup = 1 Then
' Обработка системных сообщений нулевой конечной точки.
Call Usb_processsetup(_usb_tx_status)
Elseif _usb_status._usb_endp1 = 1 Then
A(1) = _usb_rx_buffer(5) '???
A(2) = _usb_rx_buffer(4)
A(3) = _usb_rx_buffer(3)
A(4) = _usb_rx_buffer(2)End If
' Признак готовности принять следующий пакет данных.
_usb_status._usb_rtr = 1
_usb_status._usb_rxc = 0
End IfS = Bin(a(1)) + Bin(a(2)) + Bin(a(3)) + Bin(a(4))
If A(1) = 0 And A(2) = 0 And A(3) = 0 And A(4) = 0 Then
S = "00011100111111001110111001111010" ' Load
End IfLedoff
'********************* N1
Portc.5 = 1
S2 = Mid(s , 1 , 1)
If S2 = "1" Then Portb.4 = 0 '1-AS2 = Mid(s , 2 , 1)
If S2 = "1" Then Portb.0 = 0 '1-BS2 = Mid(s , 3 , 1)
If S2 = "1" Then Portc.1 = 0 '1-CS2 = Mid(s , 4 , 1)
If S2 = "1" Then Portc.3 = 0 '1-DS2 = Mid(s , 5 , 1)
If S2 = "1" Then Portc.4 = 0 '1-ES2 = Mid(s , 6 , 1)
If S2 = "1" Then Portb.3 = 0 '1-FS2 = Mid(s , 7 , 1)
If S2 = "1" Then Portc.0 = 0 '1-GS2 = Mid(s , 8 , 1)
If S2 = "1" Then Portc.2 = 0 '1-HWaitms Waitconst
Portc.5 = 0'********************* N2
Ledoff
Portb.2 = 1
S2 = Mid(s , 9 , 1)
If S2 = "1" Then Portb.4 = 0 '1-AS2 = Mid(s , 10 , 1)
If S2 = "1" Then Portb.0 = 0 '1-BS2 = Mid(s , 11 , 1)
If S2 = "1" Then Portc.1 = 0 '1-CS2 = Mid(s , 12 , 1)
If S2 = "1" Then Portc.3 = 0 '1-DS2 = Mid(s , 13 , 1)
If S2 = "1" Then Portc.4 = 0 '1-ES2 = Mid(s , 14 , 1)
If S2 = "1" Then Portb.3 = 0 '1-FS2 = Mid(s , 15 , 1)
If S2 = "1" Then Portc.0 = 0 '1-GS2 = Mid(s , 16 , 1)
If S2 = "1" Then Portc.2 = 0 '1-HWaitms Waitconst
Portb.2 = 0'********************* N3
Ledoff
Portb.1 = 1
S2 = Mid(s , 17 , 1)
If S2 = "1" Then Portb.4 = 0 '1-AS2 = Mid(s , 18 , 1)
If S2 = "1" Then Portb.0 = 0 '1-BS2 = Mid(s , 19 , 1)
If S2 = "1" Then Portc.1 = 0 '1-CS2 = Mid(s , 20 , 1)
If S2 = "1" Then Portc.3 = 0 '1-DS2 = Mid(s , 21 , 1)
If S2 = "1" Then Portc.4 = 0 '1-ES2 = Mid(s , 22 , 1)
If S2 = "1" Then Portb.3 = 0 '1-FS2 = Mid(s , 23 , 1)
If S2 = "1" Then Portc.0 = 0 '1-GS2 = Mid(s , 24 , 1)
If S2 = "1" Then Portc.2 = 0 '1-HWaitms Waitconst
Portb.1 = 0'********************* N4
Ledoff
Portb.5 = 1
S2 = Mid(s , 25 , 1)
If S2 = "1" Then Portb.4 = 0 '1-AS2 = Mid(s , 26 , 1)
If S2 = "1" Then Portb.0 = 0 '1-BS2 = Mid(s , 27 , 1)
If S2 = "1" Then Portc.1 = 0 '1-CS2 = Mid(s , 28 , 1)
If S2 = "1" Then Portc.3 = 0 '1-DS2 = Mid(s , 29 , 1)
If S2 = "1" Then Portc.4 = 0 '1-ES2 = Mid(s , 30 , 1)
If S2 = "1" Then Portb.3 = 0 '1-FS2 = Mid(s , 31 , 1)
If S2 = "1" Then Portc.0 = 0 '1-GS2 = Mid(s , 32 , 1)
If S2 = "1" Then Portc.2 = 0 '1-HWaitms Waitconst
Portb.5 = 0Buttons_current = Pind.1
Buttons_current = Buttons_current And 1
If Buttons_current <> Buttons_last Then
If _usb_tx_status2._usb_txc = 1 Then
Buttons_last = Buttons_current
If Buttons_current <> 0 Then
_usb_tx_buffer2(2) = 40
Else
_usb_tx_buffer2(2) = 20
End If
Call Usb_send(_usb_tx_status2 , 1) ' Передача в компьютер одного байта.
End If
End If
LoopSub Ledoff
Portb.4 = 1
Portb.0 = 1
Portc.1 = 1
Portc.3 = 1
Portc.4 = 1
Portb.3 = 1
Portc.0 = 1
Portc.2 = 1
Portc.5 = 0
Portb.2 = 0
Portb.1 = 0
Portb.5 = 0
End SubEnd
$include "USB\USB_Descriptor.bas"
$include "USB\USB_Subroutines.bas"
В USB_Descriptor.bas заменил описание конечной точки, типа Output с
Data &H95 , &H01 ' Report_count(1)
на
Data &H95 , &H04 ' Report_count(4) передаем 4 байта от ПК к МК
; Для компиляции программы, нужно установить библиотеку HID_Lib http://pure-basic.narod.ru/libs.html#HID_Lib
; Компилятор - PureBasic версии 4.40 или новее.CompilerIf Defined(HID_Lib_DeviceInfo, #PB_Function) = 0
CompilerError "Для компиляции программы, нужна библиотека HID_Lib."
CompilerEndIf#USB_PID=1
#USB_VID=$1234
Global W_DeviceHandle=0, R_DeviceHandle=0Procedure FindDevice_Timer()
Static Old_Test
Test=HID_Lib_DeviceTest(#USB_PID, #USB_VID)
If Test<>Old_Test
Old_Test=Test
If Test
HID_Lib_CloseDevice(W_DeviceHandle)
HID_Lib_CloseDevice(R_DeviceHandle)
W_DeviceHandle=HID_Lib_OpenDevice(#USB_PID, #USB_VID)
R_DeviceHandle=HID_Lib_OpenDevice(#USB_PID, #USB_VID)
SetGadgetText(1,"Подключено HID устройство")
Else
HID_Lib_CloseDevice(W_DeviceHandle)
HID_Lib_CloseDevice(R_DeviceHandle)
W_DeviceHandle=0 : R_DeviceHandle=0
SetGadgetText(1,"Устройство не обнаруженно ( PID — "+Hex(#USB_PID)+"H; VID — "+Hex(#USB_VID)+"H) ")
SetGadgetText(5,"Нет")
EndIf
EndIf
EndProcedureProcedure SendDevice(Command.w)
If W_DeviceHandle
HID_Lib_WriteDevice(W_DeviceHandle, @Command,5)
Else
MessageRequester("", "Нет связи с устройством!", #MB_OK|#MB_ICONWARNING)
EndIf
EndProcedureProcedure Thread(*xx)
Dim InBuffer.b(2)
Repeat
If R_DeviceHandle
HID_Lib_ReadDevice(R_DeviceHandle, @InBuffer(), 2)
If InBuffer(1)=20
SetGadgetText(5,"Да")
ElseIf InBuffer(1)=40
SetGadgetText(5,"Нет")
EndIf
EndIf
Delay(10)
ForEver
EndProcedureProcedure.l Convert(Value.l)
If Value = 0
Convert = -4
EndIf
If Value = 1
Convert = 96
EndIf
EndProcedureOpenWindow(0,0,0,320,100,"Пример работы с HID устройством",#PB_Window_MinimizeGadget|#PB_Window_Invisible|#PB_Window_ScreenCentered)
TextGadget(1,10,10,300,16,"Устройство не обнаруженно ( PID — "+Hex(#USB_PID)+"H; VID — "+Hex(#USB_VID)+"H )",#PB_Text_Center)
;ButtonGadget(2,40,70,120,24,"Зажечь светодиод")
;ButtonGadget(3,170,70,120,24,"Погасить светодиод")
ButtonGadget(2,40,70,120,24,"12.34")
ButtonGadget(3,170,70,120,24,"test.")
TextGadget(4,50,40,98,16,"Кнопка нажата?")
StringGadget(5,140,36,40,20,"Нет",1|#PB_String_ReadOnly)
FindDevice_Timer()
HideWindow(0,0)
SetTimer_(WindowID(0),1,200,@FindDevice_Timer())
CreateThread(@Thread(),0)
Repeat
Event=WaitWindowEvent()
If Event=#PB_Event_Gadget
Select EventGadget()
Case 2
SendDevice($60DBF26600)
;SendDevice($AA00)
Dim DateN.s(4)
DateN(1) = FormatDate("%hh", Date())
DateN(2) = Right(DateN(1), 1)
DateN(1) = Left(DateN(1), 1)
DateN(3) = FormatDate("%ii", Date())
DateN(4) = Right(DateN(3), 1)
DateN(3) = Left(DateN(3), 1)
Case 3
SendDevice($1E9EB61F00)
;SendDevice($5500)
EndSelect
EndIf
Until Event=#PB_Event_CloseWindow
Синим выделил изменения, красным - пока не дописанный, но не влияющий на отображение код
П.С.
А зачем в конце отправляемого значения ****00 два ноля?
Отредактировано ALEX_GREEN (04.08.2012 09:00:50)
Поделиться2104.08.2012 13:01:07
Вот часы, все отображается так :
SendDevice(%01100000110110110000000000000000) ;Отправляем "12." (первые 16 чисел - светятся ли сегменты, по 8 на 2 разряда), следующие 8 - номер, в данном случае 0 (00000000),
Тоесть 11111100-11111101-00000000-00000000 отобразит: "00."
А 01100000-11011010-00000001-00000000 отобразит: "12"
В результате получим "00.12"
; Для компиляции программы, нужно установить библиотеку HID_Lib http://pure-basic.narod.ru/libs.html#HID_Lib
; Компилятор - PureBasic версии 4.40 или новее.CompilerIf Defined(HID_Lib_DeviceInfo, #PB_Function) = 0
CompilerError "Для компиляции программы, нужна библиотека HID_Lib."
CompilerEndIf#USB_PID=1
#USB_VID=$1234
Global W_DeviceHandle=0, R_DeviceHandle=0
Global Timer.b
Global Dot.bProcedure FindDevice_Timer()
Static Old_Test
Test=HID_Lib_DeviceTest(#USB_PID, #USB_VID)
If Test<>Old_Test
Old_Test=Test
If Test
HID_Lib_CloseDevice(W_DeviceHandle)
HID_Lib_CloseDevice(R_DeviceHandle)
W_DeviceHandle=HID_Lib_OpenDevice(#USB_PID, #USB_VID)
R_DeviceHandle=HID_Lib_OpenDevice(#USB_PID, #USB_VID)
SetGadgetText(1,"Подключено HID устройство")
Else
HID_Lib_CloseDevice(W_DeviceHandle)
HID_Lib_CloseDevice(R_DeviceHandle)
W_DeviceHandle=0 : R_DeviceHandle=0
SetGadgetText(1,"Устройство не обнаруженно ( PID — "+Hex(#USB_PID)+"H; VID — "+Hex(#USB_VID)+"H) ")
SetGadgetText(5,"Нет")
EndIf
EndIf
EndProcedureProcedure SendDevice(Command.w)
If W_DeviceHandle
HID_Lib_WriteDevice(W_DeviceHandle, @Command,5)
Else
;MessageRequester("", "Нет связи с устройством!", #MB_OK|#MB_ICONWARNING)
EndIf
EndProcedureProcedure Thread(*xx)
Dim InBuffer.b(2)
Repeat
If R_DeviceHandle
HID_Lib_ReadDevice(R_DeviceHandle, @InBuffer(), 2)
If InBuffer(1)=20
SetGadgetText(5,"Да")
ElseIf InBuffer(1)=40
SetGadgetText(5,"Нет")
EndIf
EndIf
Delay(10)
ForEver
EndProcedureProcedure Convert(Value.s)
If Value = "0"
Result = 252
EndIf
If Value = "1"
Result = 96
EndIf
If Value = "2"
Result = 218
EndIf
If Value = "3"
Result = 242
EndIf
If Value = "4"
Result = 102
EndIf
If Value = "5"
Result = 182
EndIf
If Value = "6"
Result = 190
EndIf
If Value = "7"
Result = 224
EndIf
If Value = "8"
Result = 254
EndIf
If Value = "9"
Result = 246
EndIf
ProcedureReturn ResultEndProcedure
OpenWindow(0,0,0,320,100,"Пример работы с HID устройством",#PB_Window_MinimizeGadget|#PB_Window_Invisible|#PB_Window_ScreenCentered)
TextGadget(1,10,10,300,16,"Устройство не обнаруженно ( PID — "+Hex(#USB_PID)+"H; VID — "+Hex(#USB_VID)+"H )",#PB_Text_Center)
;ButtonGadget(2,40,70,120,24,"Зажечь светодиод")
;ButtonGadget(3,170,70,120,24,"Погасить светодиод")
ButtonGadget(2,40,70,120,24,"Start")
ButtonGadget(3,170,70,120,24,"Stop")
TextGadget(4,50,40,98,16,"Кнопка нажата?")
StringGadget(5,140,36,40,20,"Нет",1|#PB_String_ReadOnly)
AddWindowTimer(0, 123, 500)
FindDevice_Timer()
HideWindow(0,0)
SetTimer_(WindowID(0),1,200,@FindDevice_Timer())
CreateThread(@Thread(),0)
Repeat
Event=WaitWindowEvent()
If Event=#PB_Event_Gadget
Select EventGadget()
Case 2
Timer = 0
SendDevice(%00000001101111000000000000000000) ; Go
SendDevice(%11111101000000000000000100000000)
Delay (500)
Case 3
Timer = 1
SendDevice(%10110110000111100000000000000000) ; Stop
SendDevice(%11111100110011100000000100000000)
Delay (700)
SendDevice(%00000010000000100000000000000000) ; ----
SendDevice(%00000010000000101000000100000000)
EndSelect
EndIf
If Event = #PB_Event_Timer And EventTimer() = 123
If Timer = 0
Dim B.b(2)
Dim S.s(3)
Dim DateN.s(4)
Dot = Dot + 1
If Dot >= 2
Dot = 0
EndIf
DateN(1) = FormatDate("%hh", Date())
DateN(2) = Right(DateN(1), 1)
DateN(1) = Left(DateN(1), 1)
DateN(3) = FormatDate("%ii", Date())
DateN(4) = Right(DateN(3), 1)
DateN(3) = Left(DateN(3), 1)
B(1) = Convert(DateN(1))
S(1) = Right(RSet(Bin(B(1)), 64, "0"), 8)
B(2) = Convert(DateN(2)) + Dot
S(2) = Right(RSet(Bin(B(2)), 64, "0"), 8)
S(3) = "%"+S(1)+S(2)+"00000000"+"00000000"
SendDevice(Val(S(3)))
;*********************************************
B(1) = Convert(DateN(3))
S(1) = Right(RSet(Bin(B(1)), 64, "0"), 8)
B(2) = Convert(DateN(4))
S(2) = Right(RSet(Bin(B(2)), 64, "0"), 8)
S(3) = "%"+S(1)+S(2)+"00000001"+"00000000"
SendDevice(Val(S(3)))
;*********************************************
EndIf
EndIf
Until Event=#PB_Event_CloseWindow
$regfile = "m8def.dat"
$crystal = 12000000$hwstack = 40
$swstack = 40
$framesize = 50$include "USB\USB_Config.bas"
$include "USB\Const_swusb-includes.bas"Dim Buttons_current As Byte
Dim Buttons_last As Byte
Dim S As String * 32
Dim S2 As String * 1
Dim A(4) As Byte
Const Waitconst = 1
Declare Sub LedoffConfig Portb = Output
Config Portc = Output
Config Portd.1 = Input' Ðàçðåøàåì ïðåðûâàíèÿ.
Enable InterruptsDo
Call Usb_refresh()
' Ïîëó÷åíû äàííûå îò êîìïüþòåðà.
If _usb_status._usb_rxc = 1 Then
If _usb_status._usb_setup = 1 Then
' Îáðàáîòêà ñèñòåìíûõ ñîîáùåíèé íóëåâîé êîíå÷íîé òî÷êè.
Call Usb_processsetup(_usb_tx_status)
Elseif _usb_status._usb_endp1 = 1 Then
If _usb_rx_buffer(2) = 0 Then
A(1) = _usb_rx_buffer(4)
A(2) = _usb_rx_buffer(3)
Else
A(3) = _usb_rx_buffer(4)
A(4) = _usb_rx_buffer(3)
End IfEnd If
' Ïðèçíàê ãîòîâíîñòè ïðèíÿòü ñëåäóþùèé ïàêåò äàííûõ.
_usb_status._usb_rtr = 1
_usb_status._usb_rxc = 0
End IfS = Bin(a(1)) + Bin(a(2)) + Bin(a(3)) + Bin(a(4))
If A(1) = 0 And A(2) = 0 And A(3) = 0 And A(4) = 0 Then
S = "00011100111111001110111001111010" ' Load
End IfLedoff
'********************* N1
Portc.5 = 1
S2 = Mid(s , 1 , 1)
If S2 = "1" Then Portb.4 = 0 '1-AS2 = Mid(s , 2 , 1)
If S2 = "1" Then Portb.0 = 0 '1-BS2 = Mid(s , 3 , 1)
If S2 = "1" Then Portc.1 = 0 '1-CS2 = Mid(s , 4 , 1)
If S2 = "1" Then Portc.3 = 0 '1-DS2 = Mid(s , 5 , 1)
If S2 = "1" Then Portc.4 = 0 '1-ES2 = Mid(s , 6 , 1)
If S2 = "1" Then Portb.3 = 0 '1-FS2 = Mid(s , 7 , 1)
If S2 = "1" Then Portc.0 = 0 '1-GS2 = Mid(s , 8 , 1)
If S2 = "1" Then Portc.2 = 0 '1-HWaitms Waitconst
Portc.5 = 0'********************* N2
Ledoff
Portb.2 = 1
S2 = Mid(s , 9 , 1)
If S2 = "1" Then Portb.4 = 0 '1-AS2 = Mid(s , 10 , 1)
If S2 = "1" Then Portb.0 = 0 '1-BS2 = Mid(s , 11 , 1)
If S2 = "1" Then Portc.1 = 0 '1-CS2 = Mid(s , 12 , 1)
If S2 = "1" Then Portc.3 = 0 '1-DS2 = Mid(s , 13 , 1)
If S2 = "1" Then Portc.4 = 0 '1-ES2 = Mid(s , 14 , 1)
If S2 = "1" Then Portb.3 = 0 '1-FS2 = Mid(s , 15 , 1)
If S2 = "1" Then Portc.0 = 0 '1-GS2 = Mid(s , 16 , 1)
If S2 = "1" Then Portc.2 = 0 '1-HWaitms Waitconst
Portb.2 = 0'********************* N3
Ledoff
Portb.1 = 1
S2 = Mid(s , 17 , 1)
If S2 = "1" Then Portb.4 = 0 '1-AS2 = Mid(s , 18 , 1)
If S2 = "1" Then Portb.0 = 0 '1-BS2 = Mid(s , 19 , 1)
If S2 = "1" Then Portc.1 = 0 '1-CS2 = Mid(s , 20 , 1)
If S2 = "1" Then Portc.3 = 0 '1-DS2 = Mid(s , 21 , 1)
If S2 = "1" Then Portc.4 = 0 '1-ES2 = Mid(s , 22 , 1)
If S2 = "1" Then Portb.3 = 0 '1-FS2 = Mid(s , 23 , 1)
If S2 = "1" Then Portc.0 = 0 '1-GS2 = Mid(s , 24 , 1)
If S2 = "1" Then Portc.2 = 0 '1-HWaitms Waitconst
Portb.1 = 0'********************* N4
Ledoff
Portb.5 = 1
S2 = Mid(s , 25 , 1)
If S2 = "1" Then Portb.4 = 0 '1-AS2 = Mid(s , 26 , 1)
If S2 = "1" Then Portb.0 = 0 '1-BS2 = Mid(s , 27 , 1)
If S2 = "1" Then Portc.1 = 0 '1-CS2 = Mid(s , 28 , 1)
If S2 = "1" Then Portc.3 = 0 '1-DS2 = Mid(s , 29 , 1)
If S2 = "1" Then Portc.4 = 0 '1-ES2 = Mid(s , 30 , 1)
If S2 = "1" Then Portb.3 = 0 '1-FS2 = Mid(s , 31 , 1)
If S2 = "1" Then Portc.0 = 0 '1-GS2 = Mid(s , 32 , 1)
If S2 = "1" Then Portc.2 = 0 '1-HWaitms Waitconst
Portb.5 = 0Buttons_current = Pind.1
Buttons_current = Buttons_current And 1
If Buttons_current <> Buttons_last Then
If _usb_tx_status2._usb_txc = 1 Then
Buttons_last = Buttons_current
If Buttons_current <> 0 Then
_usb_tx_buffer2(2) = 40
Else
_usb_tx_buffer2(2) = 20
End If
Call Usb_send(_usb_tx_status2 , 1) ' Ïåðåäà÷à â êîìïüþòåð îäíîãî áàéòà.
End If
End If
LoopSub Ledoff
Portb.4 = 1
Portb.0 = 1
Portc.1 = 1
Portc.3 = 1
Portc.4 = 1
Portb.3 = 1
Portc.0 = 1
Portc.2 = 1
Portc.5 = 0
Portb.2 = 0
Portb.1 = 0
Portb.5 = 0
End SubEnd
$include "USB\USB_Descriptor.bas"
$include "USB\USB_Subroutines.bas"
В данном случае на себя все берет ПК, и МК только получает данные для отображения. После вкл. программы и подкл устройства к ПК (при подкл. к USB будет надпись "Load") на экране (если это так можно назвать) будет отображаться текущее время, и помигивать точка второго разряда с интервалом в 500 мс. Что-бы остановить мигание - нажимаем "Stop", видим аналогичную надпись на экране, далее отображаются "----".
Схемы принципиальной принципиально не делал))
Вот монтажка, там я думаю все видно и понятно, в "*.lay" формате все детали подписаны:
Печатка на RGHost
Зеркало на IFolder(Rusfolder)
На схеме, как и в программе кнопку не вырезал, можно сделать, что-бы при нажатии отображалась t процессора/видеокарты, ну или то, что вам нужно))
Отредактировано ALEX_GREEN (04.08.2012 15:51:47)
Поделиться2204.08.2012 16:44:57
Честно не понял зачем полученные данные превращать в строку и разбирать ее посимвольно?
Это же нерационально по скорости работы и размеру прошивки!
Можно ведь вообще отказаться от работы со строками и заменить этот участок:
S2 = Mid(s , 1 , 1) If S2 = "1" Then Portb.4 = 0 '1-A
на такую строку:
Portb.4 = a(0).0
С остальными сегментами аналогично.
Более того, можно использовать цикл, что в 4 раза уменьшит размер кода динамической индикации.
Что касается проги для компа. Сразу бросается в глаза эта процедура:
Procedure SendDevice(Command.w) If W_DeviceHandle HID_Lib_WriteDevice(W_DeviceHandle, @Command,5) Else ;MessageRequester("", "Нет связи с устройством!", #MB_OK|#MB_ICONWARNING) EndIf EndProcedure
Процедуре через аргумент передается всего два байта (один из которых это ID репорта), так как можно в таком случае, передать пять байтов?
Типы переменных. http://pure-basic.narod.ru/docs/books/2.htm
Поделиться2304.08.2012 19:28:13
Согласен, что не рационально использую ресурсы МК, но мне интересно было сделать рабочие часики, что-бы играя во что-то или смотря фильм можно было посмотреть время и они сами работали, их не нужно было-бы выставлять, корректировать, а ПК синхронизирует время по интернету, они работают без глюков и лагов, а мне более и не нужно. (И если честно, то влом что-то менять в коде...) Может потом поменяю, ну а сейчас пусть инфа остается на форуме, вдруг кто-то еще захочет подобное что-то сделать...То пусть сразу все норм делает. Ах да, HID_Lib_WriteDevice(W_DeviceHandle, @Command,5): пятерка - это длина буфера, как я понял, где-то в журнале радио вычитал, что должна быть на 1 больше самого буфера (не знаю почему, но после изменения Data &H95 , &H04) работает все только с 5-кой. Да и ну его, главное что работает, еще раз спасибо))
Отредактировано ALEX_GREEN (04.08.2012 19:30:38)
Поделиться2404.08.2012 20:18:56
Я ведь написал что
Процедуре через аргумент передается всего два байта (один из которых это ID репорта), так как можно в таком случае, передать пять байтов?
У переменой Command тип Word, а значит она может хранить не больше 2-ух байт.
Нужно переменная с типом Qard, в котором может хранится 8 байт.
Поделиться2504.08.2012 20:21:12
Я ж не спорю, просто, просто работает только тогда, когда стоит 5. Ай, ладно, ну его...
Поделиться2604.08.2012 20:25:31
Я имел в виду что должно быть.
Procedure SendDevice(Command.q)
Поделиться2704.08.2012 21:39:40
Да я понял, все, закрыли тему))
Переделал индикацию:
$regfile = "m8def.dat"
$crystal = 12000000$hwstack = 40
$swstack = 40
$framesize = 50$include "USB\USB_Config.bas"
$include "USB\Const_swusb-includes.bas"Dim Buttons_current As Byte
Dim Buttons_last As Byte
Dim A(4) As Byte
Const Waitconst = 1
Declare Sub Ledoff
Declare Sub Ledon(byval Nomer As Byte)Config Portb = Output
Config Portc = Output
Config Portd.1 = Input' Разрешаем прерывания.
Enable InterruptsDo
Call Usb_refresh()
' Получены данные от компьютера.
If _usb_status._usb_rxc = 1 Then
If _usb_status._usb_setup = 1 Then
' Обработка системных сообщений нулевой конечной точки.
Call Usb_processsetup(_usb_tx_status)
Elseif _usb_status._usb_endp1 = 1 Then
If _usb_rx_buffer(2) = 0 Then
A(1) = Not _usb_rx_buffer(4)
A(2) = Not _usb_rx_buffer(3)
Else
A(3) = Not _usb_rx_buffer(4)
A(4) = Not _usb_rx_buffer(3)
End IfEnd If
' Признак готовности принять следующий пакет данных.
_usb_status._usb_rtr = 1
_usb_status._usb_rxc = 0
End IfIf A(1) = 0 And A(2) = 0 And A(3) = 0 And A(4) = 0 Then
A(1) = 227 ' Инвертируем байты (255 - X)
A(2) = 3 ' и отображаем надпись "Load"
A(3) = 17
A(4) = 133
End If' 1-й разряд
Ledoff
Portc.5 = 1
Call Ledon(1)
Waitms Waitconst
Portc.5 = 0' 2-й разряд
Ledoff
Portb.2 = 1
Call Ledon(2)
Waitms Waitconst
Portb.2 = 0' 3-й разряд
Ledoff
Portb.1 = 1
Call Ledon(3)
Waitms Waitconst
Portb.1 = 0' 4-й разряд
Ledoff
Portb.5 = 1
Call Ledon(4)
Waitms Waitconst
Portb.5 = 0Buttons_current = Pind.1
Buttons_current = Buttons_current And 1
If Buttons_current <> Buttons_last Then
If _usb_tx_status2._usb_txc = 1 Then
Buttons_last = Buttons_current
If Buttons_current <> 0 Then
_usb_tx_buffer2(2) = 40
Else
_usb_tx_buffer2(2) = 20
End If
Call Usb_send(_usb_tx_status2 , 1) ' Передача в компьютер одного байта.
End If
End If
LoopSub Ledoff
Portb.4 = 1
Portb.0 = 1
Portc.1 = 1
Portc.3 = 1
Portc.4 = 1
Portb.3 = 1
Portc.0 = 1
Portc.2 = 1
Portc.5 = 0
Portb.2 = 0
Portb.1 = 0
Portb.5 = 0
End SubSub Ledon(byval Nomer As Byte)
Portb.4 = A(nomer).7 ' 1-A
Portb.0 = A(nomer).6 ' 1-B
Portc.1 = A(nomer).5 ' 1-C
Portc.3 = A(nomer).4 ' 1-D
Portc.4 = A(nomer).3 ' 1-E
Portb.3 = A(nomer).2 ' 1-F
Portc.0 = A(nomer).1 ' 1-G
Portc.2 = A(nomer).0 ' 1-H
End SubEnd
$include "USB\USB_Descriptor.bas"
$include "USB\USB_Subroutines.bas"
Отредактировано ALEX_GREEN (05.08.2012 02:10:30)