怎么实现工业称的去皮功能，用VB写的

0400240116 2007-5-14 09:16 楼主

我们公司买了一个德国的称，老大给了我一个例程。但是这个例程是一次性收到十六组数据。而我要实现去皮功能不知到从哪下手，求高手指点不胜感谢！例程片段如下：
Private sFormat(8) As String       '格式字符串-结果
Private sFormat1(8) As String    '格式字符串1-测量数组
Private weightValue(8, 15) As Double    '测量数据数组
Private IndexFocus As Integer       '四角误差焦点的顺序号
Private NoTest As Integer
Private sNoTest As String
Private maxLoop(8) As Integer             '9次测量
Private aveDev(8) As Double                '存放平均值的中值
Private sPrnTest(8, 15) As String       '存放每次测量数据换为字符串
Private sPrnNote(8, 8) As String       '存放每次除测量数据外的数据
Private Sub Form_Load()
  If Not MSComm1.PortOpen Then                               '打开串行口
      MSComm1.PortOpen = True
  End If
  If Err Then
   MsgBox "串行通信口没有打开！"
  End If

MSComm1.InBufferCount = 0                                  '接收缓冲区清零
numWeight = 0
IndexFocus = 100                                           '焦点设置为任意值
LABEL5(1).Caption = " 1"
NoTest = 1
sNoTest = "1"
End Sub

Private Sub MSComm1_OnComm()
Dim sTemp As String
Dim sReceive As String

MSComm1.InputLen = 1
Select Case MSComm1.CommEvent
   Case comEvReceive                            '接收到16个数据
         sTemp = MSComm1.Input

         If sTemp = "+" Or sTemp = "-" Or sTemp = " " Then '判断是否为天平传送首字节 + 、- 、space
            Do While sTemp <> Chr(13)                      '接收数据，判断是否为LF
            sReceive = sReceive & sTemp
            sTemp = MSComm1.Input
            Loop

            Select Case IndexFocus
                  Case 0 To 14
                  weightValue(NoTest - 1, IndexFocus) = Val(sReceive)
                        sPrnTest(NoTest - 1, IndexFocus) = sReceive
                        Text2(IndexFocus).Text = sReceive

                        If Text2(3) <> "" Then
                           If Text2(15) = "" Then
                              maxLoop(NoTest - 1) = 3
                           End If
                           CalResult
                        End If
                        Text2(IndexFocus + 1).SetFocus
                  Case 15
                        weightValue(NoTest - 1, 15) = Val(sReceive)
                        sPrnTest(NoTest - 1, 15) = sReceive
                        Text2(15).Text = sReceive
                        maxLoop(NoTest - 1) = 15
                        CalResult
                        IndexFocus = 100
            End Select
         End If



   Case comRxParity                               '接收错误
      MsgBox "警告：通信格式错  ！ "
End Select

MSComm1.InBufferCount = 0                      '接收缓冲区清零

End Sub

Private Sub text2_GotFocus(Index As Integer)

      IndexFocus = Index

End Sub
Private Sub cmdNewCal()

Dim i As Integer

            If Text2(15).Text <> "" Then       '最后一个数传输完成
                     maxLoop(NoTest - 1) = 15
   ElseIf Text2(3).Text <> "" Then                '第一个ABBA循环完成
                  maxLoop(NoTest - 1) = 3
               Else
                  Exit Sub
               End If

            For i = 0 To 15
weightValue(NoTest - 1, i) = Val(Text2(i).Text)‘手工改变的数值写入数组
               sPrnTest(NoTest - 1, i) = Text2(i).Text
            Next i

            CalResult



End Sub
Private Sub CalResult()
Dim diffValue(8) As Double                                  '存放B-A值
Dim aveValue(4) As Double                      '存放1个ABBA循环的平均值
Dim i As Integer
Dim numPoint As Integer                            '小数点的位数
Dim sReceive As String

For i = 0 To maxLoop(NoTest - 1) - 1 Step 4       '首先计算B-A
                  diffValue(i / 2) = weightValue(NoTest - 1, i) - weightValue(NoTest - 1, i + 1)
                  diffValue(i / 2 + 1) = weightValue(NoTest - 1, i + 3) - weightValue(NoTest - 1, i + 2)
               Next i

               For i = 0 To (maxLoop(NoTest - 1) - 1) / 2 Step 2                      '计算 B-A 的平均值
                  aveValue(i / 2) = (diffValue(i) + diffValue(i + 1)) / 2
               Next i

               aveDev(NoTest - 1) = 0

               For i = 0 To (maxLoop(NoTest - 1) - 3) / 4                               '计算平均值的中值，以g为单位
                  aveDev(NoTest - 1) = aveDev(NoTest - 1) + aveValue(i)

               Next i
               aveDev(NoTest - 1) = aveDev(NoTest - 1) / ((maxLoop(NoTest - 1) + 1) / 4)


               sReceive = Text2(0).Text                                     '检定完成时，计算小数点位数
               i = InStr(1, sReceive, ".", vbTextCompare)
               If i <> 0 Then
                  sTemp = Right$(sReceive, Len(sReceive) - i)
                  i = InStr(1, sTemp, " ", vbTextCompare)
                  numPoint = i - 1
               Else
                  numPoint = 0
               End If
               sFormat1(NoTest - 1) = ""
               If numPoint <= 0 Then  '设置测量数组输出格式，保存在sFormat1
                  sFormat1(NoTest - 1) = "#"
                  Else
                  For i = 1 To numPoint
                     sFormat1(NoTest - 1) = sFormat1(NoTest - 1) & "0"
                  Next i
                  sFormat1(NoTest - 1) = "########0." & sFormat1(NoTest - 1)
               End If

         numPoint = numPoint -3                                        '换为以mg作为单位

               sFormat(NoTest - 1) = ""
               If numPoint <= 0 Then                                        '设置输出格式，保存在sFormat
                  sFormat(NoTest - 1) = "#"
                  Else
                  For i = 1 To numPoint
                     sFormat(NoTest - 1) = sFormat(NoTest - 1) & "0"
                  Next i
                  sFormat(NoTest - 1) = "########0." & sFormat(NoTest - 1)
               End If

            Label6.Caption = Format(aveDev(NoTest - 1) * 1000 + Val(Text3.Text), sFormat(NoTest - 1) & "0") '显示砝码修正值
            If Text4.Text <> "" Then
               Label7.Caption = Format((Val(Label6.Caption) + Val(Text4.Text)) / 2, sFormat(NoTest - 1) & "0")
            End If

   sPrnNote(NoTest - 1, 0) = mass1.Text    '存储测量数据外的数据,检定一组数据后即打印
   sPrnNote(NoTest - 1, 1) = Text3.Text
   sPrnNote(NoTest - 1, 2) = Text4.Text
   For i = 0 To 3
      sPrnNote(NoTest - 1, 3 + i) = Text5(i).Text
   Next i
   sPrnNote(NoTest - 1, 7) = Label6.Caption
   sPrnNote(NoTest - 1, 8) = Label7.Caption

End Sub

Private Sub cmdExitW()
Unload Me
End
End Sub

怎么实现工业称的去皮功能，用VB写的

回复评论（3）

沙发 kerong12

板凳 gaohang

4楼 68872401

怎么实现工业称的去皮功能，用VB写的

回复评论 （3）

沙发 kerong12

板凳 gaohang

4楼 68872401

回复评论（3）