Xojo Conferences
MBSSep2018MunichDE
XDCMay2019MiamiUSA

Platforms to show: All Mac Windows Linux Cross-Platform

/USB/USBtest
Function:
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 Tue, 23th May 2016.
Project "USBtest.rbp"
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

Feedback, Comments & Corrections

The items on this page are in the following plugins: MBS USB Plugin.





Links
MBS FileMaker Plugins