[Visual Basic 6.0] 利用 USB_HID.dll 透過 USB Port 對 LCD、LED 控制

2013-11-14
摘要:[Visual Basic 6.0] 利用 USB_HID.dll 透過 USB Port 對 LCD、LED 控制
# 101 全國工科技藝競賽電腦修護 VB6.0 (部分功能)

'# [Visual Basic 6.0] 利用 USB_HID.dll 透過 USB Port 對 LCD、LED 控制
'# 0xDe

'USBHID.DLL
'有四個api
'opendevice : 開始與HID裝置通訊
'Writedevice : 傳送資料到HID裝置
'Readdevice : 從HID裝置接收資料
'closedevice : 結束與HID裝置通訊
Public LED As New USB_HID
Const MyVendorID = &H7777
Const MyProductID = &H1234
Dim 開關 As Boolean

Private Sub Command10_Click()
List1.AddItem 1
List1.AddItem 129
List1.AddItem 131
List1.AddItem 195
List1.AddItem 199
List1.AddItem 231
List1.AddItem 239
List1.AddItem 255
List1.AddItem 127
List1.AddItem 126
List1.AddItem 62
List1.AddItem 60
List1.AddItem 28
List1.AddItem 24
List1.AddItem 8
List1.AddItem 0
List1.AddItem 24
List1.AddItem 60
List1.AddItem 126
List1.AddItem 255
List1.AddItem 231
List1.AddItem 195
List1.AddItem 129
List1.AddItem 0
List1.AddItem 1
List1.AddItem 3
List1.AddItem 7
List1.AddItem 15
List1.AddItem 143
List1.AddItem 207
List1.AddItem 239
List1.AddItem 255
List1.AddItem 247
List1.AddItem 231
List1.AddItem 227
List1.AddItem 195
List1.AddItem 193
List1.AddItem 129
List1.AddItem 128
List1.AddItem 0
List1.AddItem 24
List1.AddItem 60
List1.AddItem 126
List1.AddItem 255
List1.AddItem 239
List1.AddItem 231
List1.AddItem 199
List1.AddItem 195
List1.AddItem 131
List1.AddItem 129
List1.AddItem 1
List1.AddItem 0

End Sub

Private Sub Command11_Click()
txt = Text4.Text

For i = 1 To Len(txt)
    Call wr_chr(Asc(Mid(txt, i, 1)))
Next i
End Sub

Private Sub Command12_Click()
Call wr_set(&H1) '清除顯示器
End Sub

Private Sub Command13_Click()
Call wr_set(&H2) '上一行
End Sub

Private Sub Command14_Click()
wr_set (&HC0) ' 下一行
End Sub

Private Sub Command15_Click()
txt = Mid(Time, 4)

For i = 1 To Len(txt)
    Call wr_chr(Asc(Mid(txt, i, 1)))
Next i
End Sub

Private Sub Command16_Click()
txt = Date

For i = 1 To Len(txt)
    Call wr_chr(Asc(Mid(txt, i, 1)))
Next i
End Sub

Private Sub Command17_Click()
List2.AddItem Text6: Text6 = ""
End Sub

Private Sub Command18_Click()
List2.Clear
End Sub

Private Sub Command19_Click()
Timer2.Interval = Val(Text7)
Timer2.Enabled = True
End Sub

Private Sub Command20_Click()
Timer2.Enabled = False
End Sub

Private Sub Command21_Click()
List2.AddItem Mid(Time, 4)
End Sub

Private Sub Command22_Click()
List2.AddItem Date
End Sub

Private Sub Command23_Click()
List2.AddItem "換行"
End Sub

Private Sub Command24_Click()
List2.AddItem "重來"
End Sub

Private Sub Command25_Click()
List2.AddItem "現在時間"
End Sub

Private Sub Command5_Click()
ans = 0

For i = 7 To 0 Step -1

    If LEDShow(i).Value = 1 Then
        ans = ans + (2 ^ i)
    End If
    
Next i

List1.AddItem ans
End Sub

Private Sub Command6_Click()
List1.Clear
End Sub

Private Sub Command7_Click()
Timer1.Interval = Val(Text3)
Timer1.Enabled = True
End Sub

Private Sub Command8_Click()
Timer1.Enabled = False
End Sub

Private Sub Command9_Click()
List1.AddItem 1
List1.AddItem 3
List1.AddItem 7
List1.AddItem 15
List1.AddItem 31
List1.AddItem 63
List1.AddItem 127
List1.AddItem 255
List1.AddItem 127
List1.AddItem 63
List1.AddItem 31
List1.AddItem 15
List1.AddItem 7
List1.AddItem 3
List1.AddItem 1
List1.AddItem 0
List1.AddItem 128
List1.AddItem 192
List1.AddItem 224
List1.AddItem 240
List1.AddItem 248
List1.AddItem 252
List1.AddItem 254
List1.AddItem 255
List1.AddItem 254
List1.AddItem 252
List1.AddItem 248
List1.AddItem 240
List1.AddItem 224
List1.AddItem 192
List1.AddItem 128
List1.AddItem 0
End Sub

'開啟HID裝置
Private Sub Form_Load()
'Shell "regsvr32 /s USB_HID.dll"
'
'    Me.Tag = 0
'    開關 = LED.opendevice(MyVendorID, MyProductID) ' 開啟 HID 裝置
'    Text1.Text = 開關
    '低電壓驅動，使用共陽極
    'a = Array(&HC0, &HF9, &HA4, &HB0, &H99, &H92, &H82, &HF8, &H80, &H90)
    '高電壓驅動，使用共陰極
    'a = Array(&H3F, &H6, &H5B, &H4F, &H66, &H6D, &H7D, &H7, &H7F, &H6F)
'LCD Init
'Call wr_set(&H1)    '清除顯示器
'Call wr_set(&H2)    '游標歸位
'Call wr_set(&H3)    '設定進入模式
'Call wr_set(&HE)    '顯示器開/閉
'Call wr_set(&H1C) '游標移位方向
'Call wr_set(&H38)   '功能設定
'Call wr_set(&H1)    '清除顯示器
End Sub
'開啟HID裝置
Private Sub Command1_Click()
    If Not 開關 Then
        開關 = LED.opendevice(MyVendorID, MyProductID) ' 開啟 HID 裝置
        Text1.Text = 開關    ' 顯示開啟結果, True : 成功, False : 失敗
    End If
End Sub
Private Sub Command2_Click()
    Dim send(1) As Byte
    Text1.Text = 開關                              ' 顯示開啟結果, True : 成功, False : 失敗
    If 開關 = True Then                            ' 若HID裝置開啟成功, 則將資料輸出至 HID裝置
        send(0) = Val(Text2.Text)                     ' 取得 控制 Port0 的 Data
        send(1) = Val(Text5.Text)
        LED.Writedevice send()                       ' 將資料輸出至 HID裝置
    Else
        MsgBox "未連接到裝置", , "LED"
    End If
End Sub
' 關閉 HID 裝置
Private Sub Command3_Click()
    LED.closedevice
End Sub

Private Sub Command4_Click()

ans = 0

For i = 7 To 0 Step -1
    If LEDShow(i).Value = 1 Then
        ans = ans + (2 ^ i)
    End If
Next i

Dim send(1) As Byte
Text1.Text = 開關                              ' 顯示開啟結果, True : 成功, False : 失敗
If 開關 = True Then                            ' 若HID裝置開啟成功, 則將資料輸出至 HID裝置
        send(0) = Val(ans)                     ' 取得 控制 Port0 的 Data
        LED.Writedevice send()                       ' 將資料輸出至 HID裝置
        Text2 = ans
    Else
        MsgBox "未連接到裝置", , "LED"
    End If
    
End Sub

Private Sub Timer1_Timer()
Dim send(1) As Byte
If Val(Me.Tag) > List1.ListCount - 1 Then Me.Tag = 0
'send(1) = List1.List(Me.Tag)
send(0) = List1.List(Me.Tag)

Me.Tag = Me.Tag + 1
LED.Writedevice send()                       ' 將資料輸出至 HID裝置
End Sub

'寫入 LCD 指令副程式
Sub wr_set(code)
    Dim send(1) As Byte
                         
    '資料
    send(0) = code
    '273正緣
    send(1) = 0
    LED.Writedevice send()
    Call delay(10000)    '等待資料穩定
    send(1) = 1
    LED.Writedevice send()
    Call delay(10000)    '等待資料穩定
    'LCD Ctrl
    send(0) = 4
    LED.Writedevice send()
    Call delay(10000)    '等待資料穩定
    send(0) = 0
    LED.Writedevice send()
    Call delay(10000)    '等待資料穩定
End Sub

'寫入 LCD 顯示字元副程式
Sub wr_chr(chr)
    Dim send(1) As Byte
    'LCD Data
    send(0) = chr
    '273 正緣
    send(1) = 0
    LED.Writedevice send()
    Call delay(10000)     '等待資料穩定
    send(1) = 1
    LED.Writedevice send()
    Call delay(10000)     '等待資料穩定
    
    'LCD Ctrl
    send(0) = 5
    LED.Writedevice send()
    Call delay(10000)     '等待資料穩定
    send(0) = 1
    LED.Writedevice send()
    Call delay(10000)     '等待資料穩定
End Sub
'延遲副程式:
Sub delay(r)
For del = 0 To r
de = del - 1
del = de + 1
Next del
End Sub

Private Sub Timer2_Timer()
Timer2.Tag = Timer2.Tag + 1
If Val(Timer2.Tag) > List2.ListCount Then Timer2.Tag = 0

txt = List2.List(Timer2.Tag)

If txt = "現在時間" Then
    txt = Mid(Time, 4)
ElseIf txt = "換行" Then
    Call wr_set(&HC0): Exit Sub ' 下一行
ElseIf txt = "重來" Then
    Call wr_set(&H1): Exit Sub '清除顯示器
End If
    For i = 1 To Len(txt)
        Call wr_chr(Asc(Mid(txt, i, 1)))
    Next i
End Sub
[Visual Basic 6.0] 利用 USB_HID.dll 透過 USB Port 對 LCD、LED 控制.rar
#0xDe 從分享中學習
#Facebook：ProgrammerDe (https://www.facebook.com/MicrosoftDes) 有問題歡迎提問
回首頁