module2.bas

一款简易的示波器程序

Attribute VB_Name = "Module2"
'**********************************
' 基本设置
'**********************************

Public intPort As Integer       '串行口号
Public strSet As String         '协议设置
Public intTime As Integer       '发送时间间隔

Public bytReceiveByte() As Byte     '接收到的字节
Public intReceiveLen As Integer     '接收到的字节数
Public bytInput() As Byte
Public intInputLen As Integer
Public BoverReceive As Boolean
Public Zero_num As Double


Public Sub Startmscomm()
'初始化串行口
    intPort = 1
    intTime = 1000
    strSet = "38400,N,8,1"
    Form1.MSComm1.InBufferSize = 1024
    Form1.MSComm1.OutBufferSize = 512
    
    If Not Form1.MSComm1.PortOpen Then
        Form1.MSComm1.CommPort = intPort
        Form1.MSComm1.Settings = strSet
        Form1.MSComm1.PortOpen = True
    End If
    
        Form1.MSComm1.InputLen = 0                                              ' 读取缓冲区全部内容
        Form1.MSComm1.InputMode = 0                                              ' 设置或返回 Input 属性取回的数据的类型 0为文本 1为二进制
        
    
        Form1.MSComm1.InBufferCount = 0                     '清除接收缓冲区
        Form1.MSComm1.RThreshold = 1                        '产生 OnComm 事件
End Sub

Public Sub clr_rmtp()
    Dim bytTemp(0) As Byte
    
    ReDim bytReceiveByte(0)
    intReceiveLen = 0
    
    Call InputManage(bytTemp, 0)
    
    intReceiveLen = 0
    intInputLenth = 0
    Form1.MSComm1.InputLen = 0                                              ' 读取缓冲区全部内容
    Form1.MSComm1.InputMode = 0                                              ' 设置或返回 Input 属性取回的数据的类型 0为文本 1为二进制
        
    
    Form1.MSComm1.InBufferCount = 0                     '清除接收缓冲区
    Form1.MSComm1.RThreshold = 1                        '产生 OnComm 事件
End Sub

Public Sub InputManage(bytInput() As Byte, intInputLenth As Integer)     ' intinputlenth 定义为双字节常数
   
    Dim n As Integer                                '定义变量及初始化
    
    ReDim Preserve bytReceiveByte(intReceiveLen + intInputLenth)      '重新定义变量 接收到的字节数

    For n = 1 To intInputLenth Step 1
        bytReceiveByte(intReceiveLen + n - 1) = bytInput(n - 1)       '将接收到的数据存放在
    Next n
    
    intReceiveLen = intReceiveLen + intInputLenth
    
End Sub

Public Sub GetDisplayText()

    Dim n, m, S, SH, SL As Double, a As Integer, BBB, CCC As Double
    Dim intValue As Byte
    Dim strSingleChr As String * 1
    Dim Pid_num1, Pid_num2 As Double
    If Form1.Option1(1).Value = True Then
        If Form1.MSComm1.PortOpen = True Then
            Form1.MSComm1.PortOpen = False                          '测量其它码（连续码)时停止接收
        End If
    End If
    
    Incepton = TURE
    BBB = 0
    ReDim Preserve Fdata(Pointer + intReceiveLen)                    'pointer为上次接收到的，未显示完的数
    For n = 1 To intReceiveLen - 1
        
        Do While bytReceiveByte(n - 1) = 0                           '虑除“0”
            n = n + 1
            Zero_num = Zero_num + 1
            If n >= intReceiveLen - 1 Then
                Exit Do
            End If
        Loop
                
        Fdata(Pointer + n) = bytReceiveByte(n - 1)
        
        S = (Fdata(Pointer + n) And &H7F) + S
            
        
        If Fdata(Pointer + n) = &HF8 Then
            BBB = BBB + 1
        Else
            BBB = 0
        End If
        
                
        If Form1.Option1(0).Value = True Then
        '处理遥控结束码
            If BBB >= 10 Then                                                            '连续10次接收到“0xf8”结束
                'Call clr_rmtp
                For m = 0 To 9
                    Fdata(Pointer + n - m) = 0                                          '去掉10个0xf8
                Next m
                ReDim Preserve Fdata(Pointer + intReceiveLen - Zero_num - 10)
                BoverReceive = True
                Zero_num = 0
                Exit For
            End If
        

        ElseIf (S * TSize) > 10000 Then
                BoverReceive = True                                         '如果接收码过长，则不是遥控码，立即显示
                If Form1.MSComm1.PortOpen = True Then
                    Form1.MSComm1.PortOpen = False                          '停止接收
                    Call clr_rmtp
                End If
                Exit For
        End If
        
        
     '   Form1.Text1.Text = Form1.Text1.Text & Hex(Fdata(Pointer + n)) & "-"
    Next n
        
    Incepton = False
    
    
    If Form1.Option1(1).Value = True And BoverReceive = True Then
        If Form1.MSComm1.PortOpen = True Then
            Form1.MSComm1.PortOpen = False
        End If
    ElseIf BoverReceive = False Then
        If Form1.MSComm1.PortOpen = False Then
            Form1.MSComm1.CommPort = intPort
            Form1.MSComm1.Settings = strSet
            Form1.MSComm1.PortOpen = True
        End If
    Else
    End If
End Sub


'处理接收到的字符，去掉空格和回车换行符
Function HandleData(Data As Variant) As String
Dim i As Long, S As String

    If Form1.MSComm1.InputMode = comInputModeBinary Then
        S = StrConv(Data, vbUnicode)
    Else
        S = Data
    End If
    S = Trim(S)
    ' 过滤/处理空格符。
    Do
       i = InStr(S, " ")
       If i Then
          If i = 1 Then
             S = Mid(S, i + 1)
          Else
             S = Left(S, i - 1) & Mid(S, i + 1)
          End If
       End If
    Loop While i

    ' 除去换行符。
    Do
       i = InStr(S, Chr$(10))
       If i Then
          S = Left$(S, i - 1) & Mid$(S, i + 1)
       End If
    Loop While i
    
    ' 除去回车符。
    Do
       i = InStr(S, Chr$(13))
       If i Then
          S = Left$(S, i - 1) & Mid$(S, i + 1)
       End If
    Loop While i
    
    HandleData = S
End Function