我编译了一段 为什么总是显示编译错误：未找到方法或者数据成员
Private Declare Function sndPlaySound Lib "winmm.dll" Alias "sndPlaySoundA" _(ByVal lpszSoundName As String, ByVal uFlags As Long) As Long
Const SND_SYNC = &H0
Const SND_ASYNC = &H1
Const SND_NODEFAULT = &H2
Const SND_LOOP = &H8
Const SND_NOSTOP = &H10
Dim hi, j, zd, yy
Dim strData As String
Dim bytInput() As Byte
Dim bytSendByte() As Byte '发送二进制数据
Dim sBarcodeTemp As String
Dim sInTemp As String
'Download by http://www.
Public Function DecimaltoHex(ByVal Dec As Long) As String
Dim Hex As String
Dim r As Long
Dim Maks As Boolean
If Dec > 0 Then
Do While Dec <> 0
r = Abs(Dec Mod 16)
Dec = Dec \ 16
Hex = IIf(r > 9, Chr(55 + r), r) & Hex
Loop
Else
Maks = True
Do While Dec <> 0
r = 15 - Abs(Dec Mod 16) - Maks
Maks = r = 16
r = IIf(r = 16, 0, r)
Dec = Dec \ 16
Hex = IIf(r > 9, Chr(55 + r), r) & Hex
Loop
End If
DecimaltoHex = IIf(Len(Hex) = 0, "00", Right("00" & Hex, 2))
End Function
Private Sub Check1_Click(Index As Integer)
Text1.Text = ""
Select Case Index
Case Index:
If Check1.Item(Index).Value = 1 Then
Shape1.Item(Index).FillColor = &HFF
Else
Shape1.Item(Index).FillColor = &HFFFFFF
End If
End Select
For ck = 0 To 7
If Check1.Item(7 - ck).Value = 1 Then
ckv = 0
Else
ckv = 1
End If
Text1.Text = Text1.Text & ckv
Next ck
End Sub
Private Sub Check2_Click(Index As Integer)
If ComPort.PortOpen = False Then
MsgBox "请先连接串口，然后在操作", vbInformation, "锐志电子温馨提示"
Exit Sub
End If
Text4.Text = ""
Select Case Index
Case Index:
If Check2.Item(Index).Value = 1 Then
Shape2.Item(Index).FillColor = &HFF
Else
Shape2.Item(Index).FillColor = &HFFFFFF
End If
End Select
For ck = 0 To 7
If Check2.Item(7 - ck).Value = 1 Then
ckv = 0
Else
ckv = 1
End If
Text4.Text = Text4.Text & ckv
Next ck
sendbin (Text6.Text)
End Sub
Private Sub cmdConnect_Click()
'查找指定端口
Dim i As Integer
For i = 1 To 16
If optComPort(i - 1).Value = True Then
= i
Exit For '跳出循环
End If
Next
If ComPort.PortOpen = True Then ComPort.PortOpen = False '如果端口打开则先关闭
ComPort.PortOpen = True '然后打开
'状态信息
lblStatus = "已连接..."
''Text1.Text = "EXIT"
cmdConnect.Enabled = False
cmdDisconnect.Enabled = True
End Sub
Private Sub cmdDisconnect_Click()
'断开连接
If ComPort.PortOpen = True Then ComPort.PortOpen = False
lblStatus = "已断开..."
cmdDisconnect.Enabled = False
cmdConnect.Enabled = True
End Sub
Private Sub cmdExit_Click()
'先断开端口再退出程序
If ComPort.PortOpen = True Then ComPort.PortOpen = False
Unload Me
End
End Sub
Private Sub Command1_Click()
If ComPort.PortOpen = False Then
MsgBox "请先连接串口，然后在操作", vbInformation, "锐志电子温馨提示"
Exit Sub
End If
Select Case UCase(Text7)
Case 0
sendbin ("31")
Case 1
sendbin ("32")
Case 2
sendbin ("33")
End Select
End Sub
Public Function StrtoHex(ByVal strs As String) As String 'str to 16
Dim abytS() As Byte
Dim bytTemp As Byte
Dim strTemp As String
Dim lLocation As Long
abytS = StrConv(strs, vbFromUnicode)
For lLocation = 0 To UBound(abytS)
bytTemp = abytS(lLocation)
strTemp = Hex(bytTemp)
strTemp = Right("00" & strTemp, 2)
StrtoHex = StrtoHex & strTemp
Next lLocation
End Function
Public Function HextoStr(ByVal strs As String) As String '16 to str
Dim i As Integer, tmp As String
If Len(strs) Mod 2 Then Exit Function
For i = 1 To Len(strs) Step 2
n = Val("&H" & Mid(strs, i, 2))
If n < 0 Or n > 127 Then
n = Val("&H" & Mid(strs, i, 4))
i = i + 2
End If
tmp = tmp & Chr(n)
Next i
HextoStr = tmp
End Function
Private Sub Command2_Click()
If ComPort.PortOpen = False Then
MsgBox "请先连接串口，然后在操作", vbInformation, "锐志电子温馨提示"
Exit Sub
End If
Text5.Text = "C0F9A4B0999282F880908883C6A1868E"
Timer1.Enabled = True
End Sub
Public Function D_To_B(ByVal Dec As Long) As String
Do
D_To_B = Dec Mod 2 & D_To_B
Dec = Dec \ 2
Loop While Dec
End Function
Public Function B_To_D(ByVal Bin As String) As Integer
Dim i As Long
For i = 1 To Len(Bin)
B_To_D = B_To_D * 2 + Val(Mid(Bin, i, 1))
Next i
End Function
Public Function H_To_B(ByVal Hex As String) As String
Dim i As Long
Dim B As String
Hex = UCase(Hex)
For i = 1 To Len(Hex)
Select Case Mid(Hex, i, 1)
Case "0": B = B & "0000"
Case "1": B = B & "0001"
Case "2": B = B & "0010"
Case "3": B = B & "0011"
Case "4": B = B & "0100"
Case "5": B = B & "0101"
Case "6": B = B & "0110"
Case "7": B = B & "0111"
Case "8": B = B & "1000"
Case "9": B = B & "1001"
Case "A": B = B & "1010"
Case "B": B = B & "1011"
Case "C": B = B & "1100"
Case "D": B = B & "1101"
Case "E": B = B & "1110"
Case "F": B = B & "1111"
End Select
Next i
While Left(B, 1) = "0"
B = Right(B, Len(B) - 1)
Wend
H_To_B = Format(B, "00000000")
End Function
Public Function B_To_H(ByVal Bin As String) As String
Dim i As Long
Dim H As String
If Len(Bin) Mod 4 <> 0 Then
Bin = String(4 - Len(Bin) Mod 4, "0" & Bin)
End If
For i = 1 To Len(Bin) Step 4
Select Case Mid(Bin, i, 4)
Case "0000": H = H & "0"
Case "0001": H = H & "1"
Case "0010": H = H & "2"
Case "0011": H = H & "3"
Case "0100": H = H & "4"
Case "0101": H = H & "5"
Case "0110": H = H & "6"
Case "0111": H = H & "7"
Case "1000": H = H & "8"
Case "1001": H = H & "9"
Case "1010": H = H & "A"
Case "1011": H = H & "B"
Case "1100": H = H & "C"
Case "1101": H = H & "D"
Case "1110": H = H & "E"
Case "1111": H = H & "F"
End Select
Next i
B_To_H = H
End Function
Function Long2Bin(Data As Long) As String
Dim tmp As String
tmp = ""
tmp = tmp & IIf(Data And 32768, "1", "0")
tmp = tmp & IIf(Data And 16384, "1", "0")
tmp = tmp & IIf(Data And 8192, "1", "0")
tmp = tmp & IIf(Data And 4096, "1", "0")
tmp = tmp & IIf(Data And 2048, "1", "0")
tmp = tmp & IIf(Data And 1024, "1", "0")
tmp = tmp & IIf(Data And 512, "1", "0")
tmp = tmp & IIf(Data And 256, "1", "0")
tmp = tmp & IIf(Data And 128, "1", "0")
tmp = tmp & IIf(Data And 64, "1", "0")
tmp = tmp & IIf(Data And 32, "1", "0")
tmp = tmp & IIf(Data And 16, "1", "0")
tmp = tmp & IIf(Data And 8, "1", "0")
tmp = tmp & IIf(Data And 4, "1", "0")
tmp = tmp & IIf(Data And 2, "1", "0")
tmp = tmp & IIf(Data And 1, "1", "0")
Long2Bin = tmp
End Function
Private Sub Command5_Click()
Timer1.Enabled = False
End Sub
Private Sub Command3_Click(Index As Integer)
If ComPort.PortOpen = False Then
MsgBox "请先连接串口，然后在操作", vbInformation, "提示"
Exit Sub
End If
Select Case Index
Case 加
sendbin ("31")
Case 减
sendbin ("32")
Case 选择
sendbin ("34")
End Select
End Sub
Private Sub Form_Load()
yy = 1
'端口循环计数器
Dim iComPort As Integer
'错误陷阱
On Error GoTo CommErrorHandle
'尝试列表存在端口
For iComPort = 1 To 16
= iComPort '指定端口号
If ComPort.PortOpen = True Then ComPort.PortOpen = False '如打开先关闭
ComPort.PortOpen = True '尝试打开
ComPort.PortOpen = False '确认成功关闭
Next
'端口配置
ComPort.InputLen = 1 '1 个字符产生接收事件
ComPort.RThreshold = 1 '1 个字符产生接收事件
'跳出错误
Exit Sub
CommErrorHandle:
'68 = 设备无效
'8002 = 端口号无效
'8012 = 端口无法打开
If Err = 68 Or Err = 8002 Or Err = 8012 Then
'端口无效时则禁止单击连接按钮
optComPort(iComPort - 1).Enabled = False
End If
'继续错误
Resume Next
End Sub
Private Sub ComPort_OnComm()
'如果已经接收数据，则继续
On Error Resume Next
If <> comEvReceive Then Exit Sub
Dim intInputLen As Integer
Select Case
Case comEvReceive
'此处添加处理接收的代码
ComPort.InputMode = comInputModeBinary '二进制接收
intInputLen = ComPort.InBufferCount
ReDim bytInput(intInputLen)
bytInput = ComPort.Input
jieshou
End Select
End Sub
Public Function jieshou() '接收数据处理为16进制
Dim i As Integer
For i = 0 To UBound(bytInput)
If Len(Hex(bytInput(i))) = 1 Then
strData = strData & "0" & Hex(bytInput(i))
'Debug.Print strData
Else
strData = strData & Hex(bytInput(i))
End If
Text3 = Hex(bytInput(i))
Text2 = Right$("00" & Text3, 2)
Text3 = H_To_B(Text3)
If Text2 = "00" Then
Text3 = "00000000"
End If
For ii = 1 To 8
df = Mid$(Text3, ii, 1)
If df = 0 Then
Shape2.Item(7 - (ii - 1)).FillColor = &HFF
'Check2.Item(7 - (ii - 1)).Value = 1
Else
Shape2.Item(7 - (ii - 1)).FillColor = &HFFFFFF
'Check2.Item(7 - (ii - 1)).Value = 0
End If
Next ii
Next
'Text2 = strData
End Function
'**********************************
'字符表示的十六进制数转化为相应的整数
'错误则返回 -1
'**********************************
Function ConvertHexChr(str As String) As Integer
Dim test As Integer
test = Asc(str)
If test >= Asc("0") And test <= Asc("9") Then
test = test - Asc("0")
ElseIf test >= Asc("a") And test <= Asc("f") Then
test = test - Asc("a") + 10
ElseIf test >= Asc("A") And test <= Asc("F") Then
test = test - Asc("A") + 10
Else
test = -1 '出错信息
End If
ConvertHexChr = test
End Function
Function strHexToByteArray(strText As String, bytByte() As Byte) As Integer
Dim HexData As Integer '十六进制(二进制)数据字节对应值
Dim hstr As String * 1 '高位字符
Dim lstr As String * 1 '低位字符
Dim HighHexData As Integer '高位数值
Dim LowHexData As Integer '低位数值
Dim HexDataLen As Integer '字节数
Dim StringLen As Integer '字符串长度
Dim Account As Integer '计数
strTestn = "" '设初值
HexDataLen = 0
strHexToByteArray = 0
StringLen = Len(strText)
Account = StringLen \ 2
ReDim bytByte(Account)
For n = 1 To StringLen
Do '清除空格
hstr = Mid(strText, n, 1)
n = n + 1
If (n - 1) > StringLen Then
HexDataLen = HexDataLen - 1
Exit For
End If
Loop While hstr = " "
Do
lstr = Mid(strText, n, 1)
n = n + 1
If (n - 1) > StringLen Then
HexDataLen = HexDataLen - 1
Exit For
End If
Loop While lstr = " "
n = n - 1
If n > StringLen Then
HexDataLen = HexDataLen - 1
Exit For
End If
HighHexData = ConvertHexChr(hstr)
LowHexData = ConvertHexChr(lstr)
If HighHexData = -1 Or LowHexData = -1 Then '遇到非法字符中断转化
HexDataLen = HexDataLen - 1
Exit For
Else
HexData = HighHexData * 16 + LowHexData
bytByte(HexDataLen) = HexData
HexDataLen = HexDataLen + 1
End If
Next n
If HexDataLen > 0 Then '修正最后一次循环改变的数值
HexDataLen = HexDataLen - 1
ReDim Preserve bytByte(HexDataLen)
Else
ReDim Preserve bytByte(0)
End If
If StringLen = 0 Then '如果是空串,则不会进入循环体
strHexToByteArray = 0
Else
strHexToByteArray = HexDataLen + 1
End If
End Function
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
'断开连接并退出
If ComPort.PortOpen = True Then ComPort.PortOpen = False
End Sub
Private Sub Text4_Change()
Text6.Text = B_To_H(Text4.Text)
End Sub
Private Sub Pause(interval)
Current = Timer
Do While Timer - Current < Val(interval)
DoEvents
Loop
End Sub
Private Sub Timer1_Timer()
Text1.Text = Mid(Text5.Text, yy, 2)
sendbin (Text1.Text)
yy = yy + 2
If yy = Len(Text5.Text) + 3 Then
yy = 1
End If
End Sub
Private Sub sendbin(sendchar As String)
longth = strHexToByteArray(sendchar, bytSendByte())
If longth > 0 Then
If ComPort.PortOpen = True Then
ComPort.Output = bytSendByte
End If
End If
End Sub
