PureBasic - форум

Информация о пользователе

Привет, Гость! Войдите или зарегистрируйтесь.



USB часы

Сообщений 1 страница 27 из 27

1

Отличный пример, если б кто-то еще сделал USB LED часы(передача на 7-ми сегментный 4-ох разрядный LED индикатор)...Ну что-бы время всегда видно было, ну или температуру видеокарты/процессора...

0

2

У нас Меги даже на радиорынке продают, только цену гнут бешеную, у других слышал в 2 раза дешевле есть... но если есть где-то недалеко подобное - спроси...
А вот с PureBasic буду разбираться, мне если чесно Microsoft Visual Studio 2008 (VB и C#) более нравятся, ну да ладно...

Отредактировано ALEX_GREEN (01.08.2012 01:59:49)

0

3

Не работает только там, где нет .NET Framework-a. Все игры, новые программы написаны там!!!

+1

4

ALEX_GREEN написал(а):

мне если чесно Microsoft Visual Studio 2008 (VB и C#) более нравятся

Пишите на чем вам удобно.
Из C# тоже можно работать с HID устройствами.

0

5

Я с VB 6.0 начинал, так-же делал, теперь пишу на VB в Студии 2008 года, там удобнее, да и на фреймворке 2.0, который есть на 7-ке. Иногда на С#, но это скорее обучение, чем творчество... Ладно, пора завязывать эту тему, буду пытаться сделать USB часы, но не уверен, что получится... Детали уже купил))

0

6

ALEX_GREEN написал(а):

USB LED часы

ALEX_GREEN написал(а):

буду пытаться сделать USB часы, но не уверен, что получится... Детали уже купил

Лучше использовать LCD индикатор, типа WH1602, потому что если в часах использовать семисигментники, то скорее всего динамическая индикация будет "дерганая" из-за прерываний от USB.

0

7

Vbs/Stertor написал(а):

Если речь идет об  электрических колебаниях, попробуйте фильтр с конденсаторами

Читайте. http://radiokot.ru/start/mcu_fpga/avr/15/
http://ru.wikipedia.org/wiki/%CF%F0%E5% … 0%ED%E8%E5

0

8

Буду пробовать пока без кондентсаторов(мысль была об этом, но собирал другие схемы с динамической индикацией - небольшое затемнение было только тогда, когда шел опрос температурного датчика, но еле заметное, прошивка не моя, поэтому ничего в ней я не понял, кроме того, как исправить глюк с отображением отрицательной температуры), а саму процедуру отображения вижу так: по USB передается 32 бита, по 8 на каждый сегмент, отображение идет в цикле, и не связанно с USB, каждая часть сегмента сверяется со своим битом, A с 1, B - 2, C-3 ... точка с 8. (с 9 до 16 - 2 сегмент и т.д.). Обновление происходит раз в минуту, когда меняется время соответственно... Программу подредактировал под себя(Источник), плату развел, теперь жду пока вытравится...

Отредактировано ALEX_GREEN (02.08.2012 19:25:31)

0

9

Комп регулярно (каждые 10 мс) "общается" с устройством даже если нет передачи или приема данных.
Поэтому нужно учитывать что 100 раз в секунду, будут возникать прерывания от USB. Запрещать прерывания нельзя, иначе произойдет сбой.

0

10

Ясно, я просто думал, что прерывания происходят только тогда, когда идет передача данных, ну ладно, сперва попробую, думаю это не сильно заметно будет, а если заметно, то емкость в 10 мкф думаю все исправит... может вообще ничего не выйдет, а может все получится))

0

11

ALEX_GREEN написал(а):

емкость в 10 мкф

Что она исправит?

0

12

индикатор будет мигать, но все-же будет отображаться или я не правильно понял? Если к каждому выводу (от A до H (точки)) подкл. параллельно кондентсатор, то его заряда должно хватить на компенсацию мигания, тоесть прийдется добавить 8 кондентсаторов.

0

13

Тогда на индикаторе будут восьмерки.
Смотрите, индикация динамическая и выводы сегментов A - H будут общими для всех разрядов.

0

14

Чет я совсем запутался... да, вы правы. Бред написал.

Отредактировано ALEX_GREEN (02.08.2012 22:35:24)

0

15

Динамическая индикация работает отлично, без мерцания, но вот что я не пойму, так это:
как передать 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"

0

16

Так работать не будет.
Нельзя использовать задержки в цикле программы, иначе нарушится работа USB.
Нужно их убрать из кода.

Вообще, динамическую индикацию лучше организовать по другому, примерно так. http://pure-basic.narod.ru/forum/bascom … mo_Led.rar
Только вызывать подпрограмму Dinam нужно не по прерываниям таймера, а в главном цикле программы.
В массиве Dinaminfo() должны быть 4 байта, выводимые на индикатор.

ALEX_GREEN написал(а):

как передать 4 байта на МК, как вообще передача идет

Посмотрите статью в журнале "Радио" 2011 № 4, в которой написано как производится обмен с USB HID устройствами.

ALEX_GREEN написал(а):

что означает 2-ка в "_usb_rx_buffer(2)", если это размер буфера в байтах, то можно ли его заменить на 4?

Это индекс массива в котором хранится принятая информация.
Чтобы увеличить число принимаемых данных до 4 байта за посылку, нужно найти в файле "USB\USB_Descriptor.bas"

Дескриптор сообщения (репорта), описывающий тип HID устройства и его характеристики

Найти там Описание конечной точки, типа Output и в строке:

Код:
Data &H95 , &H01

заменить 01 на 04.

0

17

Огромнейшее спасибо, буду пробовать)) (Это мой 3-й проект на МК, а прошивка  - первая...)

0

18

Тогда еще посмотрите статьи в журналах "Радио" 2011, №10 и №11.
В них рассматривается разработка микроконтроллерных USB устройств.

0

19

Спс, уже смотрел, нашел в ReadMe.txt))

0

20

Устройство работает, принимает данные, но вот только опять проблемма, при передаче чего-либо неправильно отображается 1-й разряд на индикаторе, например:
12.34 будет -2.34, а test. будет -.test. (точки учитываются)

Ожидание в 1 миллисекунду все-же оставил, проблемм не заметил, если убрать, то индикация некоторых сегментов получается почти незаметной, на отображение первого символа не влияет. Индикацию тоже пока оставил в цикле прерываний. Да и 3 последующих разряда спокойно отображаются, а 1-й - нет(( Может нельзя использовать _usb_rx_buffer(5)?

Уже не знаю где проблемма, вот код программы МК и для ПК:

МК (BASCOM)

$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 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
         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 If

       S = 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 If

   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

   '*********************        N4
   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"

В USB_Descriptor.bas заменил описание конечной точки, типа Output с
Data &H95 , &H01                                            ' Report_count(1)
на
Data &H95 , &H04                                            ' Report_count(4) передаем 4 байта от ПК к МК

PureBasic

; Для компиляции программы, нужно установить библиотеку 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

Procedure 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
EndProcedure

Procedure SendDevice(Command.w)
If W_DeviceHandle
   HID_Lib_WriteDevice(W_DeviceHandle, @Command,5)
Else
   MessageRequester("", "Нет связи с устройством!", #MB_OK|#MB_ICONWARNING)
EndIf
EndProcedure

Procedure 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
EndProcedure

Procedure.l Convert(Value.l)
  If Value = 0
    Convert = -4
  EndIf
     
  If Value = 1
    Convert = 96
  EndIf
       
       
EndProcedure

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,"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)

0

21

Вот часы, все отображается так :
SendDevice(%01100000110110110000000000000000) ;Отправляем "12." (первые 16 чисел - светятся ли сегменты, по 8 на 2 разряда), следующие 8 - номер, в данном случае 0 (00000000),
Тоесть 11111100-11111101-00000000-00000000 отобразит: "00."
А         01100000-11011010-00000001-00000000 отобразит: "12"
В результате получим "00.12"

PB

; Для компиляции программы, нужно установить библиотеку 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.b

Procedure 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
EndProcedure

Procedure SendDevice(Command.w)
If W_DeviceHandle
   HID_Lib_WriteDevice(W_DeviceHandle, @Command,5)
Else
   ;MessageRequester("", "Нет связи с устройством!", #MB_OK|#MB_ICONWARNING)
EndIf
EndProcedure

Procedure 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
EndProcedure

Procedure 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 Result

EndProcedure

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

BASCOM-AVR

$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 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
         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 If

      End If
      ' Ïðèçíàê ãîòîâíîñòè ïðèíÿòü ñëåäóþùèé ïàêåò äàííûõ.
      _usb_status._usb_rtr = 1
      _usb_status._usb_rxc = 0
   End If

       S = 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 If

   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

   '*********************        N4
   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"

В данном случае на себя все берет ПК, и МК только получает данные для отображения. После вкл. программы и подкл устройства к ПК (при подкл. к USB будет надпись "Load")  на экране (если это так можно назвать) будет отображаться текущее время, и помигивать точка второго разряда с интервалом в 500 мс. Что-бы остановить мигание - нажимаем "Stop", видим аналогичную надпись на экране, далее отображаются "----".

Схемы принципиальной принципиально не делал))
Вот монтажка, там я думаю все видно и понятно, в "*.lay" формате все детали подписаны:
Печатка на RGHost
Зеркало на IFolder(Rusfolder)

http://s1.uploads.ru/t/YmSjB.jpg

На схеме, как и в программе кнопку не вырезал, можно сделать, что-бы при нажатии отображалась t процессора/видеокарты, ну или то, что вам нужно))

Отредактировано ALEX_GREEN (04.08.2012 15:51:47)

0

22

Честно не понял зачем полученные данные превращать в строку и разбирать ее посимвольно?
Это же нерационально по скорости работы и размеру прошивки!
Можно ведь вообще отказаться от работы со строками и заменить этот участок:

Код:
   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

0

23

Согласен, что не рационально использую ресурсы МК, но мне интересно было сделать рабочие часики, что-бы играя во что-то или смотря фильм можно было посмотреть время и они сами работали, их не нужно было-бы выставлять, корректировать, а ПК синхронизирует время по интернету, они работают без глюков и лагов, а мне более и не нужно. (И если честно, то влом что-то менять в коде...) Может потом поменяю, ну а сейчас пусть инфа остается на форуме, вдруг кто-то еще захочет подобное что-то сделать...То пусть сразу все норм делает. Ах да, HID_Lib_WriteDevice(W_DeviceHandle, @Command,5): пятерка - это длина буфера, как я понял, где-то в журнале радио вычитал, что должна быть на 1 больше самого буфера (не знаю почему, но после изменения Data &H95 , &H04) работает все только с 5-кой. Да и ну его, главное что работает, еще раз спасибо))

Отредактировано ALEX_GREEN (04.08.2012 19:30:38)

0

24

Я ведь написал что

Пётр написал(а):

Процедуре через аргумент передается всего два байта (один из которых это ID репорта), так как можно в таком случае, передать пять байтов?

У переменой Command тип Word, а значит она может хранить не больше 2-ух байт.
Нужно переменная с типом Qard, в котором может хранится 8 байт.

0

25

Я ж не спорю, просто, просто работает только тогда, когда стоит 5. Ай, ладно, ну его...

0

26

Я имел в виду что должно быть.

Procedure SendDevice(Command.q)

0

27

Да я понял, все, закрыли тему))

Переделал индикацию:

BASCOM-AVR

$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 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
         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 If

      End If
      ' Признак готовности принять следующий пакет данных.
      _usb_status._usb_rtr = 1
      _usb_status._usb_rxc = 0
   End If

   If 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 = 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

Sub 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 Sub

End

$include "USB\USB_Descriptor.bas"
$include "USB\USB_Subroutines.bas"

Отредактировано ALEX_GREEN (05.08.2012 02:10:30)

0