大家帮我看一下这个程序~~谢谢啦！
高手帮我看一下啊~！！
itm.SubItems(1) = "一个"
itm.SubItems(2) = "两个"
itm.SubItems(3) = "三个"
itm.SubItems(4) = "四个"
Next count
End Sub
Private Sub cmd_PTD_Calibration_Click()
frmdelete.Show 1, Form_main
End Sub
Private Sub cmd_PTA_Calibration_Click()
' frmadd.Show 1, Form_main
Dim dblValue As Double
Dim lIndex As Long
Dim i As Long
Dim oOpt As OptionButton
Dim dblArr() As Double
ReDim dblArr(optPos1.UBound + 1)
dblValue = CDbl(txt_add.Text)
For i = 0 To optPos1.UBound
dblArr(i) = optPos1(i).Tag
Next i
'排序
dblArr(optPos1.UBound + 1) = dblValue
Quicksort dblArr, 0, UBound(dblArr)
lIndex = FindIndexInArr(dblValue, dblArr)
Load optPos1(optPos1.UBound + 1)
Set oOpt = optPos1(optPos1.UBound)
i = optPos1.UBound - 1
oOpt.Move optPos1(i).Left, optPos1(i).Top + optPos1(i).Height + 10 * Screen.TwipsPerPixelX
oOpt.Visible = True
'插入值
For i = UBound(dblArr) To lIndex Step -1
Set oOpt = optPos1(i)
oOpt.Tag = dblArr(i)
oOpt.Caption = "第" & i + 1 & "点 (" & Format(oOpt.Tag, "0.00#") & ")"
Next i
End Sub
'Private Sub Command6_Click()
' Combo1.Clear '清空仪表列表
' MSComm.Output = "12345678" '串口发送数据
'End Sub
Private Sub Form_Load()
MSComm.PortOpen = True
Dim count As Integer
Dim str As String
str = "COM"
For count = 1 To 12
Combo_com.AddItem str & count
Next count
'插入标定点为： （需修改）
optPos1(0).Tag = 0.1
optPos1(0).Width = 100 * Screen.TwipsPerPixelX
optPos1(0).Caption = "第1点(0.10)"
initOpt
'Dim wd() As Byte
'Dim ss() As Byte
'Dim wts As wspon '定义仪表写响应结构
'Dim wt As wdir '定义主机写命令
' wt.wd(0) = &H1
' wt.wd(7) = ss(0)
' wt.wd(8) = ss(1)
' wt.wd(9) = ss(2)
' wt.wd(10) = ss(3)
' wt.wdcheck = CRC(wt.wd(), 11)
' Dim buf$
' buf = Trim(MSComm.Input)
' If Len(buf) = 0 Then
' Combo1.AddItem ""
' Else
' Combo1.AddItem "buf"
' End If
' MSComm.Settings = "9600,n,8,1," ' 设置波特率和发送字符格式
' MSComm.InputLen = 0 ' 设置或返回一次从接收缓冲区中读取字节数，0表示一次读取所有数据
' MSComm.InBufferSize = 512 ' 设置接收缓冲区512Byte
' MSComm.InBufferCount = 0
' MSComm.InputMode = 1 '从串口读取二进制数据
' MSComm.OutBufferSize = 512 ' 设置发送缓冲区512Byte
' MSComm.OutBufferCount = 0
' MSComm.RThreshold = 1 ' 每个字符到接收缓冲区都触发接收事件
' MSComm.SThreshold = 1
' MSComm.PortOpen = True ' 打开串口
' Dim hComm As Long
' Dim szTest As String
' 打开串口1
' hComm = OpenComm(1)
' If hComm <> 0 Then
' 设置串口通讯参数
' SetCommParam hComm
' 设置串口超时
' SetCommTimeOut hComm, 2, 3
End Sub
'从数组里找出符合条件的元素
Private Function FindIndexInArr(ByVal dblVal As Double, ByRef dblArr() As Double) As Long
Dim lIndex As Long
FindIndexInArr = -1
For lIndex = 0 To UBound(dblArr)
If dblVal = dblArr(lIndex) Then
FindIndexInArr = lIndex
Exit For
End If
Next
End Function
'快速排序
'Sort the items in array values() with bounds min and max.
'CSEH: ErrRaise
Sub Quicksort(values As Variant, ByVal Min As Long, ByVal Max As Long)
Dim med_value As String
Dim hi As Long
Dim lo As Long
Dim i As Long
'If the list has only 1 item, it's sorted.
If Min >= Max Then Exit Sub
'Pick a dividing item randomly.
i = Min + Int(Rnd(Max - Min + 1))
med_value = values(i)
'Swap the dividing item to the front of the list.
values(i) = values(Min)
'Separate the list into sublists.
lo = Min
hi = Max
Do
'Look down from hi for a value < med_value.
Do While values(hi) >= med_value
hi = hi - 1
If hi <= lo Then Exit Do
Loop
If hi <= lo Then
'The list is separated.
values(lo) = med_value
Exit Do
End If
'Swap the lo and hi values.
values(lo) = values(hi)
'Look up from lo for a value >= med_value.
lo = lo + 1
Do While values(lo) < med_value
lo = lo + 1
If lo >= hi Then Exit Do
Loop
If lo >= hi Then
'The list is separated.
lo = hi
values(hi) = med_value
Exit Do
End If
'Swap the lo and hi values.
values(hi) = values(lo)
Loop
'Recursively sort the sublists.
Quicksort values, Min, lo - 1
Quicksort values, lo + 1, Max
End Sub
[解决办法]
txt_Linear_cp6.Text = "2.5 MPa"
txt_Linear_cp7.Text = "3.0 MPa"
txt_Linear_cp8.Text = "3.5 MPa"
txt_Linear_cp9.Text = "4.0 MPa"
txt_Linear_cp10.Text = ""
txt_Linear_cp11.Text = ""
End Sub
Private Sub Linear_cp6_Click()
txt_Linear_cp1.Text = "0 MPa"
txt_Linear_cp2.Text = "1 MPa"
txt_Linear_cp3.Text = "2 MPa"
txt_Linear_cp4.Text = "3 MPa"
txt_Linear_cp5.Text = "4 MPa"
txt_Linear_cp6.Text = "5 MPa"
txt_Linear_cp7.Text = "6 MPa"
txt_Linear_cp8.Text = ""
txt_Linear_cp9.Text = ""
txt_Linear_cp10.Text = ""
txt_Linear_cp11.Text = ""
End Sub
Private Sub Linear_cp7_Click()
txt_Linear_cp1.Text = "0 MPa"
txt_Linear_cp2.Text = "1 MPa"
txt_Linear_cp3.Text = "2 MPa"
txt_Linear_cp4.Text = "3 MPa"
txt_Linear_cp5.Text = "4 MPa"
txt_Linear_cp6.Text = "5 MPa"
txt_Linear_cp7.Text = "6 MPa"
txt_Linear_cp8.Text = "7 MPa"
txt_Linear_cp9.Text = "8 MPa"
txt_Linear_cp10.Text = "9 MPa"
txt_Linear_cp11.Text = "10 MPa"
End Sub
Private Sub Linear_cp8_Click()
txt_Linear_cp1.Text = "0 MPa"
txt_Linear_cp2.Text = "1 MPa"
txt_Linear_cp3.Text = "2 MPa"
txt_Linear_cp4.Text = "3 MPa"
txt_Linear_cp5.Text = "4 MPa"
txt_Linear_cp6.Text = "5 MPa"
txt_Linear_cp7.Text = "6 MPa"
txt_Linear_cp8.Text = "7 MPa"
txt_Linear_cp9.Text = "8 MPa"
txt_Linear_cp10.Text = "9 MPa"
txt_Linear_cp11.Text = "10 MPa"
End Sub
Private Sub Linear_cp9_Click()
txt_Linear_cp1.Text = "0 MPa"
txt_Linear_cp2.Text = "5 MPa"
txt_Linear_cp3.Text = "10 MPa"
txt_Linear_cp4.Text = "15 MPa"
txt_Linear_cp5.Text = "20 MPa"
txt_Linear_cp6.Text = "25 MPa"
txt_Linear_cp7.Text = ""
txt_Linear_cp8.Text = ""
txt_Linear_cp9.Text = ""
txt_Linear_cp10.Text = ""
txt_Linear_cp11.Text = ""
End Sub
Private Sub Linear_cp10_Click()
txt_Linear_cp1.Text = "0 MPa"
txt_Linear_cp2.Text = "5 MPa"
txt_Linear_cp3.Text = "10 MPa"
txt_Linear_cp4.Text = "15 MPa"
txt_Linear_cp5.Text = "20 MPa"
txt_Linear_cp6.Text = "25 MPa"
txt_Linear_cp7.Text = "30 MPa"
txt_Linear_cp8.Text = "35 MPa"
txt_Linear_cp9.Text = "40 MPa"
txt_Linear_cp10.Text = ""
txt_Linear_cp11.Text = ""
End Sub
Private Sub Linear_cp11_Click()
txt_Linear_cp1.Text = "0 MPa"
txt_Linear_cp2.Text = "10 MPa"
txt_Linear_cp3.Text = "20 MPa"
txt_Linear_cp4.Text = "30 MPa"
txt_Linear_cp5.Text = "40 MPa"
txt_Linear_cp6.Text = "50 MPa"
txt_Linear_cp7.Text = "60 MPa"
txt_Linear_cp8.Text = ""
txt_Linear_cp9.Text = ""
txt_Linear_cp10.Text = ""
txt_Linear_cp11.Text = ""
End Sub
Private Sub Linear_cp12_Click()
txt_Linear_cp1.Text = "0 MPa"
txt_Linear_cp2.Text = "10 MPa"
txt_Linear_cp3.Text = "20 MPa"
txt_Linear_cp4.Text = "30 MPa"
txt_Linear_cp5.Text = "40 MPa"
txt_Linear_cp6.Text = "50 MPa"
txt_Linear_cp7.Text = "60 MPa"
txt_Linear_cp8.Text = "70 MPa"
txt_Linear_cp9.Text = "80 MPa"
txt_Linear_cp10.Text = "90 MPa"
txt_Linear_cp11.Text = "100 MPa"
End Sub
Private Sub Cmd_Linear_cp1_Click()
ss() = CByte(txt_Linear_cp1.Text) '文本框中的数据
wt.wd(2) = &H10
wt.wd(3) = &H80
MSComm.Output = wt
End Sub
Private Sub Cmd_Linear_cp2_Click()
ss() = CByte(txt_Linear_cp2.Text) '文本框中的数据
wt.wd(2) = &H10
wt.wd(3) = &H82
MSComm.Output = wt
End Sub
Private Sub Cmd_Linear_cp3_Click()
ss() = CByte(txt_Linear_cp3.Text) '文本框中的数据
wt.wd(2) = &H10
wt.wd(3) = &H84
MSComm.Output = wt
End Sub
Private Sub Cmd_Linear_cp4_Click()
ss() = CByte(txt_Linear_cp4.Text) '文本框中的数据
wt.wd(2) = &H10
wt.wd(3) = &H86
MSComm.Output = wt
End Sub
Private Sub Cmd_Linear_cp5_Click()
ss() = CByte(txt_Linear_cp5.Text) '文本框中的数据
wt.wd(2) = &H10
wt.wd(3) = &H88
MSComm.Output = wt
End Sub
Private Sub Cmd_Linear_cp6_Click()
ss() = CByte(txt_Linear_cp6.Text) '文本框中的数据
wt.wd(2) = &H10
wt.wd(3) = &H8A
MSComm.Output = wt
End Sub
Private Sub Cmd_Linear_cp7_Click()
ss() = CByte(txt_Linear_cp7.Text) '文本框中的数据
wt.wd(2) = &H10
wt.wd(3) = &H8C
MSComm.Output = wt
End Sub
Private Sub Cmd_Linear_cp8_Click()
ss() = CByte(txt_Linear_cp8.Text) '文本框中的数据
wt.wd(2) = &H10
wt.wd(3) = &H8E
MSComm.Output = wt
End Sub
Private Sub Cmd_Linear_cp9_Click()
ss() = CByte(txt_Linear_cp9.Text) '文本框中的数据
wt.wd(2) = &H10
wt.wd(3) = &H90
MSComm.Output = wt
End Sub
Private Sub Cmd_Linear_cp10_Click()
ss() = CByte(txt_Linear_cp10.Text) '文本框中的数据
wt.wd(2) = &H10
wt.wd(3) = &H9B
MSComm.Output = wt
End Sub
Private Sub Cmd_Linear_cp11_Click()
ss() = CByte(txt_Linear_cp11.Text) '文本框中的数据
wt.wd(2) = &H10
wt.wd(3) = &H9D
MSComm.Output = wt
End Sub
Private Sub MSComm_OnComm()
Dim i As Integer
Select Case MSComm.CommEvent
Case comEvReceive
wspon = MSComm.Input
For i = 1 To 5
If wts.wds(i) <> wt.wd(i) Then
MsgBox "写入错误"
Next i
End If
End Sub
[解决办法]
这是模块里的程序Option Explicit
Declare Sub CopyMemory Lib "KERNEL32" Alias "RtlMoveMemory" ( _
lpvDest As Any, lpvSource As Any, ByVal cbCopy As Long) '联合体实现
'数据校验
Public Function CRC16(data() As Byte, count As Integer) As Integer
Dim CRC16Hi As Byte
Dim CRC16Lo As Byte
CRC16Hi = &HFF
CRC16Lo = &HFF
Dim i As Integer
Dim iIndex As Long
For i = 0 To count
iIndex = CRC16Lo Xor data(i)
CRC16Lo = CRC16Hi Xor GetCRCLo(iIndex) '低位处理
CRC16Hi = GetCRCHi(iIndex) '高位处理
Next i
Dim ReturnData
ReturnData = CRC16Hi * 256 + CRC16Lo
CRC16 = ReturnData
End Function
'CRC低位字节值表
Function GetCRCLo(Ind As Long) As Byte
GetCRCLo = Choose(Ind + 1, &H0, &HC1, &H81, &H40, &H1, &HC0, &H80, &H41, &H1, &HC0, &H80, &H41, &H0, &HC1, &H81, &H40, &H1, &HC0, &H80, &H41, &H0, &HC1, &H81, &H40, &H0, &HC1, &H81, &H40, &H1, &HC0, &H80, &H41, &H1, &HC0, &H80, &H41, &H0, &HC1, &H81, &H40, &H0, &HC1, &H81, &H40, &H1, &HC0, &H80, &H41, &H0, &HC1, &H81, &H40, &H1, &HC0, &H80, &H41, &H1, &HC0, &H80, &H41, &H0, &HC1, &H81, &H40, &H1, &HC0, &H80, &H41, &H0, &HC1, &H81, &H40, &H0, &HC1, &H81, &H40, &H1, &HC0, &H80, &H41, &H0, &HC1, &H81, &H40, &H1, &HC0, &H80, &H41, &H1, &HC0, &H80, &H41, &H0, &HC1, &H81, &H40, &H0, &HC1, &H81, &H40, &H1, &HC0, &H80, &H41, &H1, &HC0, &H80, &H41, &H0, &HC1, &H81, &H40, &H1, &HC0, &H80, &H41, &H0, &HC1, &H81, &H40, &H0, &HC1, &H81, &H40, &H1, &HC0, &H80, &H41, &H1, &HC0, _
&H80, &H41, &H0, &HC1, &H81, &H40, &H0, &HC1, &H81, &H40, &H1, &HC0, &H80, &H41, &H0, &HC1, &H81, &H40, &H1, &HC0, &H80, &H41, &H1, &HC0, &H80, &H41, &H0, &HC1, &H81, &H40, &H0, &HC1, &H81, &H40, &H1, &HC0, &H80, &H41, &H1, &HC0, &H80, &H41, &H0, &HC1, &H81, &H40, &H1, &HC0, &H80, &H41, &H0, &HC1, &H81, &H40, &H0, &HC1, &H81, &H40, &H1, &HC0, &H80, &H41, &H0, &HC1, &H81, &H40, &H1, &HC0, &H80, &H41, &H1, &HC0, &H80, &H41, &H0, &HC1, &H81, &H40, &H1, &HC0, &H80, &H41, &H0, &HC1, &H81, &H40, &H0, &HC1, &H81, &H40, &H1, &HC0, &H80, &H41, &H1, &HC0, &H80, &H41, &H0, &HC1, &H81, &H40, &H0, &HC1, &H81, &H40, &H1, &HC0, &H80, &H41, &H0, &HC1, &H81, &H40, &H1, &HC0, &H80, &H41, &H1, &HC0, &H80, &H41, &H0, &HC1, &H81, &H40)
End Function
'CRC高位字节值表
Function GetCRCHi(Ind As Long) As Byte
GetCRCHi = Choose(Ind + 1, &H0, &HC0, &HC1, &H1, &HC3, &H3, &H2, &HC2, &HC6, &H6, &H7, &HC7, &H5, &HC5, &HC4, &H4, &HCC, &HC, &HD, &HCD, &HF, &HCF, &HCE, &HE, &HA, &HCA, &HCB, &HB, &HC9, &H9, &H8, &HC8, &HD8, &H18, &H19, &HD9, &H1B, &HDB, &HDA, &H1A, &H1E, &HDE, &HDF, &H1F, &HDD, &H1D, &H1C, &HDC, &H14, &HD4, &HD5, &H15, &HD7, &H17, &H16, &HD6, &HD2, &H12, &H13, &HD3, &H11, &HD1, &HD0, &H10, &HF0, &H30, &H31, &HF1, &H33, &HF3, &HF2, &H32, &H36, &HF6, &HF7, &H37, &HF5, &H35, &H34, &HF4, &H3C, &HFC, &HFD, &H3D, &HFF, &H3F, &H3E, &HFE, &HFA, &H3A, &H3B, &HFB, &H39, &HF9, &HF8, &H38, &H28, &HE8, &HE9, &H29, &HEB, &H2B, &H2A, &HEA, &HEE, &H2E, &H2F, &HEF, &H2D, &HED, &HEC, &H2C, &HE4, &H24, &H25, &HE5, &H27, &HE7, &HE6, &H26, &H22, &HE2, &HE3, &H23, &HE1, &H21, &H20, &HE0, &HA0, &H60, _
&H61, &HA1, &H63, &HA3, &HA2, &H62, &H66, &HA6, &HA7, &H67, &HA5, &H65, &H64, &HA4, &H6C, &HAC, &HAD, &H6D, &HAF, &H6F, &H6E, &HAE, &HAA, &H6A, &H6B, &HAB, &H69, &HA9, &HA8, &H68, &H78, &HB8, &HB9, &H79, &HBB, &H7B, &H7A, &HBA, &HBE, &H7E, &H7F, &HBF, &H7D, &HBD, &HBC, &H7C, &HB4, &H74, &H75, &HB5, &H77, &HB7, &HB6, &H76, &H72, &HB2, &HB3, &H73, &HB1, &H71, &H70, &HB0, &H50, &H90, &H91, &H51, &H93, &H53, &H52, &H92, &H96, &H56, &H57, &H97, &H55, &H95, &H94, &H54, &H9C, &H5C, &H5D, &H9D, &H5F, &H9F, &H9E, &H5E, &H5A, &H9A, &H9B, &H5B, &H99, &H59, &H58, &H98, &H88, &H48, &H49, &H89, &H4B, &H8B, &H8A, &H4A, &H4E, &H8E, &H8F, &H4F, &H8D, &H4D, &H4C, &H8C, &H44, &H84, &H85, &H45, &H87, &H47, &H46, &H86, &H82, &H42, &H43, &H83, &H41, &H81, &H80, &H40)
End Function
'传入连续4个字节首地址 返回有符号长整型值
Public Function BTL(data() As Byte) As Long
Dim ReturnData As Long
CopyMemory ReturnData, data, 4
BTL = ReturnData
End Function
'传入连续4个字节首地址 返回浮点型值
Public Function BTS(data() As Byte) As Single
Dim ReturnData As Single
CopyMemory ReturnData, data, 4
BTS = ReturnData
End Function
'将有符号长整形转换成4字节型
Public Sub LTB(sdat As Long, data() As Byte)
CopyMemory data, sdat, 4
End Sub
Public Sub STB(sdata As Single, data() As Byte)
CopyMemory data, sdat, 4
End Sub
[解决办法]
写入仪表部分的命令，是怎么弄也弄不出来啊~~呜呜 ~~
[解决办法]
有问题找我
[解决办法]
QQ:184324486
[解决办法]
用这个工具调试。你可以找个正确的程序通信，然后抓下数据，和你自己程序对比一下就知道自己错在哪了。
下载地址：
http://download.cnet.com/ComTrace/3000-2218_4-75156892.html?tag=mncol
感觉好别忘了给个review(评论)，谢谢！
[解决办法]
我是电子硬件，VB，VC大师级高手，QQ：184324486
读写串口必须用Variant变量
你的程序中没看到用控件数组，用数组很多时候方便得多，代码成倍减少，也方便阅读
串口应该通过注册表查找到相应的有效端口号列表（比如COM1，COM2，COM4）
然后通过在各个端口之间，以各种离散频率（4800，9600，19200，14400，28800，38400，57600，115200）定时查询设备(一般取50-1000ms）,前提是必须做好协议，最好有个专门的握手协议.
加我发程序给你
