module1.bas

Visual basic in embeddd systems to inhance th gui

    CLng(Capabilities.InputReportByteLength), _
    NumberOfBytesRead, _
    HIDOverlapped)
ReadReport = Result
'Call DisplayResultOfAPICall("ReadFile")

'lstResults.AddItem "waiting for ReadFile"
'Scroll to the bottom of the list box.
'lstResults.ListIndex = lstResults.ListCount - 1
bAlertable = True

'******************************************************************************
'WaitForSingleObject
'Used with overlapped ReadFile.
'Returns when ReadFile has received the requested amount of data or on timeout.
'Requires an event object created with CreateEvent
'and a timeout value in milliseconds.
'******************************************************************************
Result = WaitForSingleObject _
    (EventObject, _
    1000)
Call DisplayResultOfAPICall("WaitForSingleObject")

'Find out if ReadFile completed or timeout.
Select Case Result
    Case WAIT_OBJECT_0
        'ReadFile has completed
'        lstResults.AddItem "ReadFile completed successfully."
    Case WAIT_TIMEOUT
        'Timeout
 '       lstResults.AddItem "Readfile timeout"
        'Cancel the operation
        
        '*************************************************************
        'CancelIo
        'Cancels the ReadFile
        'Requires the device handle.
        'Returns non-zero on success.
        '*************************************************************
        Result = CancelIo _
            (ReadHandle)
'        lstResults.AddItem "************ReadFile timeout*************"
'        lstResults.AddItem "CancelIO"
        Call DisplayResultOfAPICall("CancelIo")
        'The timeout may have been because the device was removed,
        'so close any open handles and
        'set MyDeviceDetected=False to cause the application to
        'look for the device on the next attempt.
        CloseHandle (HIDHandle)
        Call DisplayResultOfAPICall("CloseHandle (HIDHandle)")
        CloseHandle (ReadHandle)
        Call DisplayResultOfAPICall("CloseHandle (ReadHandle)")
        MyDeviceDetected = False
    Case Else
'        lstResults.AddItem "Readfile undefined error"
        MyDeviceDetected = False
End Select
    
'lstResults.AddItem " Report ID: " & ReadBuffer(0)
'lstResults.AddItem " Report Data:"


'******************************************************************************
'ResetEvent
'Sets the event object in the overlapped structure to non-signaled.
'Requires a handle to the event object.
'Returns non-zero on success.
'******************************************************************************

Call ResetEvent(EventObject)
Call DisplayResultOfAPICall("ResetEvent")
End Function


Public Sub Shutdown()
'Actions that must execute when the program ends.

'Close the open handles to the device.
Result = CloseHandle _
    (HIDHandle)
'Call DisplayResultOfAPICall("CloseHandle (HIDHandle)")

Result = CloseHandle _
    (ReadHandle)
'Call DisplayResultOfAPICall("CloseHandle (ReadHandle)")

End Sub






Function Dec2Bin(MyByte As Byte) As String
    Dim CurrentData As Integer
    Dim OldData As Integer
    Dim i As Integer
    
    Dec2Bin = ""
    OldData = MyByte
    
    For i = 7 To 0 Step -1
     
        CurrentData = OldData - (2 ^ i)
        If CurrentData < 0 Then
            Dec2Bin = Dec2Bin & "0"
        Else
            OldData = CurrentData
            Dec2Bin = Dec2Bin & "1"
        End If
    
    Next i
    
End Function
Function Dec2BinLong(MyInt As Integer) As String
    Dim CurrentData As Integer
    Dim OldData As Integer
    Dim i As Integer
    
    Dec2BinLong = ""
    OldData = MyInt
    
    For i = 15 To 0 Step -1
     
        CurrentData = OldData - (2 ^ i)
        If CurrentData < 0 Then
            Dec2BinLong = Dec2BinLong & "0"
        Else
            OldData = CurrentData
            Dec2BinLong = Dec2BinLong & "1"
        End If
    
    Next i
    
End Function


Function Dec2Hex(MyInteger As Integer, MyWidth As Integer) As String
    Dim TempWork As String
    
    TempWork = Hex(MyInteger)
    
    If Len(TempWork) > CLng(MyWidth) Then
        Dec2Hex = Mid(TempWork, Len(TempWork) - MyWidth, MyWidth)
        Exit Function
    End If
    
    Do Until Len(TempWork) = CLng(MyWidth)
        TempWork = "0" & TempWork
    Loop
    
    Dec2Hex = TempWork
End Function

Function LongDec2Hex(MyLong As Long, MyWidth As Integer) As String
    Dim TempWork As String
    
    TempWork = Hex(MyLong)
    
    If Len(TempWork) > CLng(MyWidth) Then
        LongDec2Hex = Mid(TempWork, Len(TempWork) - MyWidth, MyWidth)
        Exit Function
    End If
    
    Do Until Len(TempWork) = CLng(MyWidth)
        TempWork = "0" & TempWork
    Loop
    
    LongDec2Hex = TempWork
End Function


Function Unsign2Sign(MyByte As Byte) As Integer
    Dim TempData As Integer
    
    If (MyByte And 128) > 0 Then
        Unsign2Sign = CInt(MyByte - 256)
    Else
        Unsign2Sign = MyByte
    End If
End Function

' Function CheckBoard looks to see if indeed the PICkit 1 board is attached
' and if there is a device in the socket.
'Public Function CheckBoard() As Boolean
'    MessageBox.BackColor = &H8000000F
'    MessageBox.Caption = "Checking Device..."
'    DoEvents
'    ProgrammerVersion = ReadTheVersion
'
'    If ProgrammerVersion = "0.0.0" Then
'        ProgrammerVersion = "Programmer not found..."
'        MDIForm1.lblMessage.Caption = ProgrammerVersion
'        CheckBoard = False
'    Else
'        If (ProgrammerVersion = "1.0.0") Then
'        ' Old firmware version - disable unsupported functions
'            MDIForm1.cboSpeed.Enabled = False
'            MDIForm1.cboSamples.Enabled = False
'            MDIForm1.cboTrigger.Enabled = False
'            MDIForm1.tbTrigger.Enabled = False
'            MDIForm1.cmdFFT.Enabled = False
'            MDIForm1.cmdOScope.Enabled = False
'            MDIForm1.cmdHistogram.Enabled = False
'            MDIForm1.cmdStripChart.Enabled = False
'            MDIForm1.cmdGo.Enabled = False
'            MDIForm1.cmdStop.Enabled = False
'            MDIForm1.Label3.Enabled = False
'            MDIForm1.Label4.Enabled = False
'        Else
'            InquireDevice
'            If (DeviceName = "Not Present") Then
'                MDIForm1.lblMessage.Caption = "Insert Device"
'                PowerDownDevice
'                CheckBoard = False
'            Else ' We have new firmware and a device is present.
'                CheckBoard = True
'                Select Case DeviceName  ' download the appropriate command table
'                Case "PIC12F629", "PIC12F675", "PIC16F630", "PIC16F676"
'                    Call WriteToDevice(CMDTABLE, &H0, &H2, &H3, &H4, &H5, &H6, &H8)
'                    Call WriteToDevice(&H18, &HA, &H9, &HB, &HFF, &HFF, &HFF, &HFF)
'                Case "PIC16F716"
'                    Call WriteToDevice(CMDTABLE, &H0, &H2, &H3, &H4, &H5, &H6, &H8)
'                    Call WriteToDevice(&H18, &HE, &H9, &HB, &HFF, &HFF, &HFF, &HFF)
'                Case "PIC16F27A", "PIC16F28A", "PIC16F48A"
'                    Call WriteToDevice(CMDTABLE, &H0, &H2, &H3, &H4, &H5, &H6, &H8)
'                    Call WriteToDevice(&H18, &HA, &H9, &HB, &HFF, &HFF, &HFF, &HFF)
'                Case "PIC16F635", "PIC16F636", "PIC12F683", "PIC16F684", "PIC16F688"
'                    Call WriteToDevice(CMDTABLE, &H0, &H2, &H3, &H4, &H5, &H6, &H8)
'                    Call WriteToDevice(&H18, &HA, &H9, &HB, &HFF, &HFF, &HFF, &HFF)
'                End Select
'
'            End If
'        End If
'
'    End If
'End Function
'
' Gets the firmware version of the PICkit board
' tries three times before giving up.
Function ReadTheVersion() As String
    Dim VerString As String
    Dim i As Integer

    For i = 1 To 3
        Call WriteToDevice(GETVERSION, NULLCMD, NULLCMD, NULLCMD, NULLCMD, NULLCMD, NULLCMD, NULLCMD)
        ReadReport
        VerString = Chr$(ReadBuffer(1) + Asc("0")) & "." & Chr$(ReadBuffer(2) + Asc("0")) & "." & Chr$(ReadBuffer(3) + Asc("0"))
        If ReadBuffer(1) <> 0 Then Exit For
    Next i
    ReadTheVersion = VerString
End Function
' Gets the Device Id from the device on the board, looks it up and displays
' the device name on the dialog box
'Public Sub InquireDevice()
'    Dim CSum As Long
'    Dim MaskedConfig As Integer
'    Dim BufferCSum As Long
'
'    PowerDownDevice
'    Sleep 500
'
'    Call WriteToDevice(CMDTABLE, &H0, &H2, &H3, &H4, &H5, &H6, &H8)
'    Call WriteToDevice(&H18, &HA, &H9, &HB, &HFF, &HFF, &HFF, &HFF)
'    Call WriteToDevice(ENTERPGM, WRITECONFIG, READPGM, NULLCMD, NULLCMD, NULLCMD, NULLCMD, NULLCMD) '
'    ReadReport
'
'    Call WriteToDevice(READPGM, EXITPGM, NULLCMD, NULLCMD, NULLCMD, NULLCMD, NULLCMD, NULLCMD) '
'    ReadReport
'    DevId = ReadBuffer(5) + ReadBuffer(6) * 256
'    LookupDevice
'    ProgCon.TBDeviceID = DeviceName
'
'    If (DeviceSaveBGBits = True) Then
'        BandGap = (ReadBuffer(8) * 256) And &H3000
'        ProgCon.lblBandGap = "0x" & Dec2Hex(CInt(BandGap), 4)
'    End If
'
'    If (DeviceSaveOscCal = True) Then
'        Call WriteToDevice(ENTERPGM, INCADDRESS, &HFF, 3, READPGM, EXITPGM, NULLCMD, NULLCMD)
'        Sleep (500) ' wait for it to count up
'        ReadReport
'        OscCalL = ReadBuffer(1)
'        OscCalH = ReadBuffer(2)
'        ProgCon.lblOscCal = "0x" & Dec2Hex(CInt(OscCalH), 2) & Dec2Hex(CInt(OscCalL), 2)
'    End If
'    SendPowerControl
'End Sub


Public Sub PowerUpDevice()
    Call WriteToDevice(POWERCTRL, 1, NULLCMD, NULLCMD, NULLCMD, NULLCMD, NULLCMD, NULLCMD)
End Sub

' Powers down the device and the 2.5kHz oscillator.
Public Sub PowerDownDevice()
    Call WriteToDevice(POWERCTRL, 0, NULLCMD, NULLCMD, NULLCMD, NULLCMD, NULLCMD, NULLCMD)
End Sub