Platforms to show: All Mac Windows Linux Cross-Platform
Required plugins for this example: MBS USB Plugin
You find this example project in your Plugins Download as a Xojo project file within the examples folder: /USB/USBtest
This example is the version from Mon, 5th May 2019.
Project "USBtest.xojo_binary_project"
Class App Inherits Application
Const kEditClear = "&Delete"
Const kFileQuit = "&Quit"
Const kFileQuitShortcut = ""
EventHandler Sub Open()
// This is for the Custom Computer Services Inc.
// PIC24 development board. http://www.ccsinfo.com/product_info.php?products_id=usb-pic24-kit
// At present this is for Mac only, will need to add target testing and Windows code
App.mycount = 0
if not InitInstance then
quit
end if
End EventHandler
Protected Function FindDevice() As MyHID
dim h as MyHID
dim p as string
h=new MyHID
if h.FindFirstDevice then
// compare here Product name, ProductID and VendorID
p=h.Product
if left(p,3)="CCS" then
Return h
end if
while h.FindNextDevice
p=h.Product
if left(p,3)="CCS" then
Window1.statusField.BackColor = &C00FF00
Window1.statusField.Text = "CCS demo Connected"
Return h
end if
wend
end if
End Function
Function InitInstance() As boolean
if OpenUSBDevice = False Then
Return False
Else
Return True
end if
End Function
Function OpenUSBDevice() As boolean
h=FindDevice
if h=nil then
MsgBox "No CCS device found."
quit
Return false
end if
h.Connect
if h.Lasterror<>0 then
MsgBox "Failed to connect to CCS Device."
quit
Return false
end if
h.InstallCallback
Return true
End Function
Note "Description"
This is a test program that enumerates a USB HID device on a Custom Computer Services Inc PIC24 USB development board.
After enumeration a 'Request message' button on Window1 can be used to send a specific character via USB to the
development board. On receipt of the 'Request message' character the PIC development board sends five 16 byte packets
containing the test string. These packets are received and displayed in an edit field in Window1.
Further development hopes to provide a text field to contain user test strings which can be sent to the PIC development
board to be displayed on the LCD display.
A version to compile for Windows is also planned.
Written by:
Vern hardingham
Resonant Light Technology Inc.
British Columbia,
Canada
vern@resonantlight.com
Property h As myHID
Property myCount As Integer
End Class
Class Window1 Inherits Window
Control statusField Inherits TextField
ControlInstance statusField Inherits TextField
End Control
Control RxDataField Inherits TextArea
ControlInstance RxDataField Inherits TextArea
End Control
Control PushButton1 Inherits PushButton
ControlInstance PushButton1 Inherits PushButton
EventHandler Sub Action()
Window1.RxDataField.Text = Window1.RxDataField.Text + chr(13)
App.h.Send chr(86)
End EventHandler
End Control
End Class
MenuBar MenuBar1
MenuItem FileMenu = "&File"
MenuItem FileQuit = "#App.kFileQuit"
MenuItem EditMenu = "&Edit"
MenuItem EditUndo = "&Undo"
MenuItem UntitledMenu1 = "-"
MenuItem EditCut = "Cu&t"
MenuItem EditCopy = "&Copy"
MenuItem EditPaste = "&Paste"
MenuItem EditClear = "#App.kEditClear"
MenuItem UntitledMenu0 = "-"
MenuItem EditSelectAll = "Select &All"
End MenuBar
Class MyHID Inherits MacHIDMBS
EventHandler Sub ReceivedData(data as string, size as integer)
Window1.RxDataField.Text = Window1.RxDataField.Text + data
App.mycount = App.mycount + 1
End EventHandler
Sub Send(data As string)
dim m as New MemoryBlock(16)
m.StringValue(0, 1) = data
me.SendMessageMemory m, 0, 16
if me.Lasterror = -536854447 Then
MsgBox "The USB Receiver failed with a timeout to send an answer"
Quit
end if
End Sub
End Class
End Project
The items on this page are in the following plugins: MBS USB Plugin.
