Электроника и автоматика на МК

// устройство и частота  
Device = 18F4550
Clock = 48
// настроечные фьюсы
Config
  PLLDIV = 5,
  CPUDIV = OSC1_PLL2,
  USBDIV = 2,
  FOSC = HSPLL_HS,
  VREGEN = ON
// настройки для LCD
#option LCD_DATA = PORTD.4
#option LCD_RS = PORTD.1
#option LCD_EN = PORTD.0
'#option LCD_RW = PORTD.2
// подключаем дескриптор сгенерированный EasyHID
#option USB_DESCRIPTOR = "USB_VBA_ProjectDesc.bas"
// импортируем библиотеки  

Include "ADC.bas" // ADC
Include "convert.bas" // Конвертирование данных
Include "LCD.bas" // LCD алфавитно-цифровой
Include "usbhid.bas" // HID

// читаем значение канала АЦП и преобразовываем значение 0 - 5 Вольт...
Function ADInAsVolt(Numn_Ch As Byte) As Word
  result = (ADC.Read(Numn_Ch) + 1) * 500 / 1024
End Function

   

Dim Buffer(64) As Byte // буффер для приема-отправки через USB
Dim LEDS As PORTB // светодиоды
Dim KEY1 As PORTC.0 // Кнопка 1
Dim KEY2 As PORTC.1 // Кнопка 2
Dim AD1,AD2 As Word // Значеня каналов АЦП
Dim LCD_ST1, LCD_ST2 As String //Первая и вторая строка LCD
Dim i As Byte // временные переменные
// настройка портов
ADCON1 = $07 // PORTE цифровой
TRISA.0 = 1 // AN0, AN1 вход
TRISA.1 = 1  
ADCON1.7 = 1 // AN0, AN1 аналоговые входа
TRISB=0 // PORTB выход
TRISC=$FF // PORTC in
LEDS=0 // очищаем LEDS
PORTE=0 // очищаем PORTE

DelayMS (500) // задержка перед старотом для правильной настройки портов и LCD
LCD.Cls // все ясно, очистка LCD
LEDS=0
LCD.WriteAt(1,1,"Test")
While true

// Соединение через USB...
Repeat
  Service
Until Attached
//**********************************************************************************
// Основная программа
   
  // Если есть новые данные, то принимаем и обрабатываем
If DataAvailable Then // если есть новые данные из компа
  ReadArray(Buffer,64) // читаем данные из компа
  LCD_ST1="" // чистим переменные для LCD
  LCD_ST2=""
  For i=0 To 15 // набиваем первую строку для LCD  
  LCD_ST1=LCD_ST1+Char(Buffer(i))
  Next

  For i=16 To 31 // набиваем вторую строку для LCD  
  LCD_ST1=LCD_ST1+Char(Buffer(i))
  Next
  // выводим новые данные на LCD  
  LCD.WriteAt(1,1,LCD_ST1)
  LCD.WriteAt(2,1,LCD_ST2)
  // Обновляем светодиоды
  LEDS=Buffer(32)
EndIf

  // Данные в комп
  AD1=ADInAsVolt(0) // читаем значение 0 канала АЦП
  AD2=ADInAsVolt(1) // читаем значение 1 канала АЦП
  // Подготавливаем данные
  Buffer(0)=0 // на свякий пожарный чиcтим перед записью значений
  Buffer(0).0=Not KEY1 // бит 0 значение кнопки 1 (Инверсия)
  Buffer(0).1=Not KEY2 // бит 1 значение кнопки 2 (Инверсия)
  Buffer(1) = AD1/ 100 // челое значение AD1
  Buffer(2) = AD1- Buffer(1)*100 // значение после запятой AD1
  Buffer(3) = AD2 / 100 // челое значение AD2
  Buffer(4) = AD2- Buffer(3)*100 // значение после запятой AD2
  // отправляем в комп
  WriteArray(Buffer,64)
   
  // Проверяем соединение с USB
  Service
Wend

' Код сгенерированный EASYHID
Private Const VendorID = 6017
Private Const ProductID = 2000

' Размер буффера чтения - записи
Private Const BufferInSize = 64
Private Const BufferOutSize = 64
Dim BufferIn(0 To BufferInSize) As Byte
Dim BufferOut(0 To BufferOutSize) As Byte
' Строки для отправки на LCD
Dim LCD1_OUT As String
Dim LCD2_OUT As String

' ****************************************************************
' when the form loads, connect to the HID controller - pass
' the form window handle so that you can receive notification
' events...
'*****************************************************************
Private Sub Form_Load()
  ' do not remove! Проверка соединения с USB
  ConnectToHID (Me.hwnd)
  ' подготовка формы для вывода
  For i = 0 To 7: Ch_LED(i).Caption = "Led " + Chr(49 + i): Ch_LED(i).Value = Unchecked: Next i
  Text_LCD1.Text = "": Text_LCD2.Text = ""
  For i = 0 To 3: Text_ADC(i).Text = "": Text_ADC(i).Enabled = False: Text_ADC(i).Alignment = 2: Next i
End Sub

'*****************************************************************
' При выгрузки программы принудительное отсоединение от HID
'*****************************************************************
Private Sub Form_Unload(Cancel As Integer)
  DisconnectFromHID
End Sub

'*****************************************************************
' Действие при присоединении HID устройства
'*****************************************************************
Public Sub OnPlugged(ByVal pHandle As Long)
  If hidGetVendorID(pHandle) = VendorID And hidGetProductID(pHandle) = ProductID Then
  ' ** YOUR CODE HERE **
  Label_Connect.Caption = "Connect"
  End If
End Sub

'*****************************************************************
' Действие при отсоединении HID устройства
'*****************************************************************
Public Sub OnUnplugged(ByVal pHandle As Long)
  If hidGetVendorID(pHandle) = VendorID And hidGetProductID(pHandle) = ProductID Then
  ' ** YOUR CODE HERE **
  Label_Connect.Caption = "Disconnect"
  End If
End Sub

'*****************************************************************
' controller changed notification - called
' after ALL HID devices are plugged or unplugged
'*****************************************************************
Public Sub OnChanged()
  Dim DeviceHandle As Long
   
  ' get the handle of the device we are interested in, then set
  ' its read notify flag to true - this ensures you get a read
  ' notification message when there is some data to read...
  DeviceHandle = hidGetHandle(VendorID, ProductID)
  hidSetReadNotify DeviceHandle, True
End Sub

'*****************************************************************
' Читаем данные из PIC a
'*****************************************************************
Public Sub OnRead(ByVal pHandle As Long)
  If hidRead(pHandle, BufferIn(0)) Then
  ' ** YOUR CODE HERE **
  ' Переносим значения кнопок
  MainForm.Caption = BufferIn(1)
  Select Case BufferIn(1)
  Case 0
  Ch_Key(0).Value = Unchecked: Ch_Key(1).Value = Unchecked
  Case 1
  Ch_Key(0).Value = Checked: Ch_Key(1).Value = Unchecked
  Case 2
  Ch_Key(1).Value = Checked: Ch_Key(0).Value = Unchecked
  Case 3
  Ch_Key(0).Value = Checked: Ch_Key(1).Value = Checked
  End Select
  ' Переносим значения АЦП
  Text_ADC(0).Text = BufferIn(2)
  Text_ADC(1).Text = BufferIn(3)
  Text_ADC(2).Text = BufferIn(4)
  Text_ADC(3).Text = BufferIn(5)
  End If
End Sub

'*****************************************************************
' Процедура для записи в PIC
'*****************************************************************
Public Sub WriteSomeData()
  BufferOut(0) = 0 ' first by is always the report ID
  hidWriteEx VendorID, ProductID, BufferOut(0)
End Sub
' Перезапись буффера для первой строки LCD
Private Sub Text_LCD1_Change()
If Len(Text_LCD1.Text) <= 16 Then
LCD1_OUT = RTrim(Text_LCD1.Text)
For i = 1 To Len(LCD1_OUT)
BufferOut(i) = Asc(Mid(LCD1_OUT, i, 1))
Next i
WriteSomeData
Else
Text_LCD1.Text = ""
For i = 1 To 16
BufferOut(i) = 0
Next i
WriteSomeData
End If
End Sub
' То же что и выше, но для втрой строки
Private Sub Text_LCD2_Change()
If Len(Text_LCD2.Text) <= 16 Then
LCD2_OUT = RTrim(Text_LCD2.Text)
For i = 1 To Len(LCD2_OUT)
BufferOut(i + 16) = Asc(Mid(LCD2_OUT, i, 1))
Next i
WriteSomeData
Else
Text_LCD2.Text = ""
For i = 17 To 32
BufferOut(i) = 0
Next i
WriteSomeData
End If

End Sub
' Обновление состояния светодиодов
Private Sub Ch_LED_Click(Index As Integer)
BufferOut(33) = 0
  If Ch_LED(0).Value = Checked Then BufferOut(33) = BufferOut(33) + 1
  If Ch_LED(1).Value = Checked Then BufferOut(33) = BufferOut(33) + 2
  If Ch_LED(2).Value = Checked Then BufferOut(33) = BufferOut(33) + 4
  If Ch_LED(3).Value = Checked Then BufferOut(33) = BufferOut(33) + 8
  If Ch_LED(4).Value = Checked Then BufferOut(33) = BufferOut(33) + 16
  If Ch_LED(5).Value = Checked Then BufferOut(33) = BufferOut(33) + 32
  If Ch_LED(6).Value = Checked Then BufferOut(33) = BufferOut(33) + 64
  If Ch_LED(7).Value = Checked Then BufferOut(33) = BufferOut(33) + 128
WriteSomeData
MainForm.Caption = BufferOut(33)
End Sub