form2.frm

VB 代码

VERSION 5.00
Object = "{648A5603-2C6E-101B-82B6-000000000014}#1.1#0"; "MSCOMM32.OCX"
Begin VB.Form Form1 
   Caption         =   "Form1"
   ClientHeight    =   6795
   ClientLeft      =   630
   ClientTop       =   540
   ClientWidth     =   9720
   LinkTopic       =   "Form1"
   ScaleHeight     =   6795
   ScaleWidth      =   9720
   Begin VB.PictureBox Picture1 
      BackColor       =   &H00000000&
      ForeColor       =   &H00000000&
      Height          =   3135
      Left            =   120
      ScaleHeight     =   205
      ScaleMode       =   3  'Pixel
      ScaleWidth      =   501
      TabIndex        =   5
      Top             =   2760
      Width           =   7575
   End
   Begin VB.CommandButton Command2 
      Caption         =   "Command2"
      Height          =   495
      Left            =   3600
      TabIndex        =   4
      Top             =   6120
      Width           =   2175
   End
   Begin MSCommLib.MSComm MSComm1 
      Left            =   2640
      Top             =   6120
      _ExtentX        =   1005
      _ExtentY        =   1005
      _Version        =   327680
      DTREnable       =   -1  'True
      InputMode       =   1
   End
   Begin VB.TextBox Text3 
      Height          =   735
      Left            =   120
      MultiLine       =   -1  'True
      TabIndex        =   3
      Top             =   1560
      Width           =   7095
   End
   Begin VB.TextBox Text2 
      Height          =   735
      Left            =   120
      MultiLine       =   -1  'True
      TabIndex        =   2
      Top             =   720
      Width           =   7095
   End
   Begin VB.TextBox Text1 
      Height          =   495
      Left            =   120
      MultiLine       =   -1  'True
      TabIndex        =   1
      Top             =   120
      Width           =   7095
   End
   Begin VB.CommandButton Command1 
      Caption         =   "Command1"
      Height          =   495
      Left            =   360
      TabIndex        =   0
      Top             =   6120
      Width           =   1815
   End
   Begin VB.Label Label5 
      Caption         =   "Label5"
      Height          =   255
      Left            =   7800
      TabIndex        =   10
      Top             =   2760
      Width           =   1575
   End
   Begin VB.Label Label4 
      Caption         =   "Label4"
      Height          =   255
      Left            =   7800
      TabIndex        =   9
      Top             =   3480
      Width           =   1575
   End
   Begin VB.Label Label3 
      Caption         =   "Label2"
      Height          =   255
      Left            =   7800
      TabIndex        =   8
      Top             =   4200
      Width           =   1455
   End
   Begin VB.Label Label2 
      Caption         =   "Label2"
      Height          =   255
      Left            =   7800
      TabIndex        =   7
      Top             =   4920
      Width           =   1455
   End
   Begin VB.Label Label1 
      Caption         =   "Label1"
      Height          =   255
      Left            =   7800
      TabIndex        =   6
      Top             =   5760
      Width           =   1455
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False

Private lngS1 As Long
Private lngS2 As Long
Private chrBuff(1 To 6) As Byte
Private lngBLen As Long
Private chrFIFO(1 To 16) As Byte
Private lenFIFO As Byte
Private lngR1 As Long
Private lngR2 As Long

Private s_pause As Long
Private pic_X As Long
Private pic_prevY As Long

Private meanBuff(199) As Long
Private meanPtr As Long
Private meanSum As Double

Private Sub Command1_Click()
Dim strTemp As String
Dim lngLen As Long
    
    Text1.Text = ""
    lngS1 = Int((&H7FFFF + 1) * Rnd)
    lngS2 = Int((&H7FFFF + 1) * Rnd)
    Text1.Text = Text1.Text + Str(lngS1) + " " + Str(lngS2) + Chr(13) + Chr(10)
    Text1.Text = Text1.Text + Hex(lngS1) + " " + Hex(lngS2) + Chr(13) + Chr(10)
    
    Text2.Text = ""
    Call s_Code
    For i = 1 To 6
        Text2.Text = Text2.Text + Hex((chrBuff(i) And &HF0) / &H10) + Hex(chrBuff(i) And &HF) + " "
    Next i
    Text2.Text = Text2.Text + Chr(13) + Chr(10)
    
    'simulated receiving process
    lenFIFO = 16
    For i = 1 To 7
        chrFIFO(i) = Int((&H7F + 1) * Rnd)
    Next i
    For i = 8 To 13
        chrFIFO(i) = chrBuff(i - 7)
    Next i
    For i = 14 To 16
        chrFIFO(i) = Int((&H7F + 1) * Rnd)
    Next i
    For i = 1 To 16
        Text2.Text = Text2.Text + Hex((chrFIFO(i) And &HF0) / &H10) + Hex(chrFIFO(i) And &HF) + " "
    Next i
    Text2.Text = Text2.Text + Chr(13) + Chr(10)
    
    Call s_Sync
    For i = 1 To 6
        Text2.Text = Text2.Text + Hex((chrBuff(i) And &HF0) / &H10) + Hex(chrBuff(i) And &HF) + " "
    Next i
    Text2.Text = Text2.Text + Chr(13) + Chr(10)

    Text3.Text = ""
    Call s_Decode
    Text3.Text = Text3.Text + Str(lngR1) + " " + Str(lngR2) + Chr(13) + Chr(10)
    Text3.Text = Text3.Text + Hex(lngR1) + " " + Hex(lngR2) + Chr(13) + Chr(10)

End Sub

Private Sub s_Code()
    chrBuff(1) = (lngS1 And &H7F) Or &H80
    chrBuff(2) = (lngS1 And &H3F80) / &H80
    chrBuff(3) = (lngS1 And &H7C000) / &H4000
    chrBuff(4) = (lngS2 And &H7F)
    chrBuff(5) = (lngS2 And &H3F80) / &H80
    chrBuff(6) = (lngS2 And &H7C000) / &H4000
End Sub

Private Sub s_Sync()
    For i = 1 To lenFIFO
        If ((chrFIFO(i) And &H80) >= 1) Then
            If (lenFIFO - i >= 5) Then
                For j = i To i + 5
                    chrBuff(j - i + 1) = chrFIFO(j)
                Next j
            End If
            i = lenFIFO
        End If
    Next i

End Sub

Private Sub s_Decode()
    lngR1 = (chrBuff(3) And &H3F) * &H80
    lngR1 = (lngR1 Or (chrBuff(2) And &H7F)) * &H80
    lngR1 = lngR1 Or (chrBuff(1) And &H7F)
    
    lngR2 = (chrBuff(6) And &H3F) * &H80
    lngR2 = (lngR2 Or (chrBuff(5) And &H7F)) * &H80
    lngR2 = lngR2 Or (chrBuff(4) And &H7F)
End Sub

'hhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhh
Private Function comInit()
On Error GoTo err:
    MSComm1.CommPort = 1
    'MSComm1.Settings = "115200,n,8,1"
    MSComm1.Settings = "28800,n,8,1"
    'MSComm1.Settings = "9600,n,8,1"
    MSComm1.InputLen = 1
    MSComm1.RThreshold = 1
    MSComm1.InBufferCount = 0
    MSComm1.PortOpen = True
    comInit = 0
    
    s_pause = 0
    
    Exit Function
err:
    comInit = 1
End Function

Private Sub Command2_Click()
    If s_pause = 1 Then
        s_pause = 0
    Else
        s_pause = 1
    End If
End Sub

Private Sub Form_Load()
    Call comInit
    
    pic_X = 0
    Picture1.Scale (0, Picture1.ScaleHeight - 1 + 1200000)-(Picture1.ScaleWidth - 1, 1200000)
    
    meanPtr = 0
    'meanSum = 50000000 * 200
    For i = 0 To 200 - 1
        meanBuff(i) = 33000000
        meanSum = meanSum + meanBuff(i)
    Next i
    
End Sub

Private Sub Form_Unload(Cancel As Integer)
    If MSComm1.PortOpen Then MSComm1.PortOpen = False
End Sub

Private Function MeanV(V As Long) As Long
    meanSum = meanSum + V - meanBuff(meanPtr)
    meanBuff(meanPtr) = V
    meanPtr = (meanPtr + 1) Mod 200

    MeanV = meanSum / 200
End Function

Private Sub D_wave(Y As Long)
Dim BotLne As Long
    Picture1.ForeColor = 0
    Picture1.Line (pic_X, Picture1.ScaleTop - 1)-(pic_X, Picture1.ScaleTop - 205)
    Picture1.ForeColor = RGB(100, 255, 100)
    
    BotLne = (-Fix(-Fix(MeanV(Y) / 100 * 2) / 2) * 100 - 100) 'Round to 100
    'BotLne = 50000000 - 200
    
    If pic_X = 0 Then
        Label1.Caption = Str(BotLne) + Str(Picture1.ScaleTop)
        Label2.Caption = Str(BotLne + 50)
        Label3.Caption = Str(BotLne + 100)
        Label4.Caption = Str(BotLne + 150)
        Label5.Caption = Str(BotLne + 200)
        Picture1.Scale (0, 205 - 1 + BotLne)-(501, BotLne)
        Picture1.PSet (pic_X, Y), RGB(100, 255, 100)
        pic_prevY = Y
    Else
        Picture1.Line (pic_X - 1, pic_prevY)-(pic_X, Y)
        pic_prevY = Y
        Picture1.PSet (pic_X, BotLne + 50), &HFFFFFF
        Picture1.PSet (pic_X, BotLne + 100), &HFFFFFF
        Picture1.PSet (pic_X, BotLne + 150), &HFFFFFF
    End If


    pic_X = (pic_X + 1) Mod 500
End Sub

Private Sub MSComm1_OnComm()
On Error Resume Next
    Select Case MSComm1.CommEvent
    ' Handle each event or error by placing
    ' code below each case statement
        Case comEventBreak  ' 收到 Break。
        Case comEventCDTO    ' CD (RLSD) 超时。
        Case comEventCTSTO  ' CTS Timeout。
        Case comEventDSRTO  ' DSR Timeout。
        Case comEventFrame  ' Framing Error
        Case comEventOverrun    '数据丢失。
        Case comEventRxOver '接收缓冲区溢出。
        Case comEventRxParity ' Parity 错误。
        Case comEventTxFull '传输缓冲区已满。
        Case comEventDCB    '获取 DCB] 时意外错误事件
        Case comEvCD    ' CD 线状态变化。
        Case comEvCTS   ' CTS 线状态变化。
        Case comEvDSR   ' DSR 线状态变化。
        Case comEvRing  ' Ring Indicator 变化。
        Case comEvReceive   ' 收到 RThreshold # of chars.
            Dim buffer() As Byte
            MSComm1.InputLen = MSComm1.InBufferCount
            buffer = MSComm1.Input
            If s_pause = 0 Then
                For i = 0 To MSComm1.InputLen - 1
                    If ((buffer(i) And &H80)) > 0 Then
                        lngBLen = 1
                        chrBuff(1) = buffer(i)
                    Else
                        lngBLen = lngBLen + 1
                        chrBuff(lngBLen) = buffer(i)
                        If (lngBLen >= 6) Then
                            lngBLen = 0
                            Text2.Text = ""
                            For j = 1 To 6
                                Text2.Text = Text2.Text + Hex((chrBuff(j) And &HF0) / &H10) + Hex(chrBuff(j) And &HF) + " "
                            Next j
                            Call s_Decode
                            Text3.Text = ""
                            Text3.Text = Text3.Text + Str(lngR1) + " " + Str(lngR2) + Chr(13) + Chr(10)
                            Dim fx As Double
                            fx = lngR2 / lngR1 * 32000000
                            Text3.Text = Text3.Text + Str(fx) + Chr(13) + Chr(10)
                            Call D_wave(Int(fx))
                        End If
                    End If
                Next i
            End If
        Case comEvSend  ' 传输缓冲区有 Sthreshold 个字符
            'send messages
        Case comEvEOF   ' 输入数据流中发现 EOF 字符
    End Select
End Sub

Private Sub Picture1_Click()
    For i = 1 To 500
        Call D_wave((Picture1.ScaleTop - 100) + Int((80 + 1) * Rnd) - 40 + 100)
    Next i
End Sub