module1.bas

一款简易的示波器程序

Attribute VB_Name = "Module1"
Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer
Declare Function GetMessageTime Lib "user32" () As Long
Public X1, X2, X3, X4, Y1, Y2, Y3, Y4 As Double
Public Fdata() As Byte
Public Pointer As Double
Public Incepton As Boolean
Public Showdata() As Byte
Public Showbuff As Long
Public a As Long
Public Show_Num As Double
'*********************
'按键
'*********************
Public Bkeydown As Boolean
Public TSize As Double
Public Tsiza_Num As Byte
Public Bline1Down As Boolean
Public picnum As Double
Public Bkey_view As Boolean
Public RightArrow As Boolean
Public Leftarrow As Boolean
Public KeyResult As Long
Public Key_pause As Boolean
Public Key_HightNum As Double
Public Key_LowNum As Double
Public Bpause As Boolean
'*********************
'时间
'*********************
Public B100ms As Boolean

Public Sub INIT()
    Call clr_rmtp
    Form1.Picture1.Cls
    X1 = 0
    X2 = 0
    Y1 = 1200
    Y2 = 1200
    Form1.Text1.Text = ""
    Form1.AutoRedraw = True
    Form1.Picture1.AutoRedraw = True
    Showbuff = 0
End Sub


Function ZH1(ByVal Y1 As Double, ByVal Y2 As Integer) As String
Dim a As Double, b As Double, D As String, x As Integer
Do
a = Int(Y1 / Y2): b = Y1 - a * Y2: Y1 = a
If b > 9 Then D = Chr(b + 55) + D Else D = LTrim(Str(b)) + D
x = x + 1: If x = 4 And Y1 > 0 Then x = 0: D = "," + D
Loop While Y1 > 0
ZH1 = D
End Function

Function ZH2(Y1 As String, ByVal Y2 As Integer) As Double
Dim a As Integer, b As Double, D As String, i As Integer, L As Integer
L = Len(Y1)
For i = 0 To L - 1
D = Mid(Y1, L - i, 1): a = Asc(D) - 48: If a > 9 Then a = a - 7: If a > 15 Then a = a - 32
If a > 0 Then b = b + a * Y2 ^ i
Next
ZH2 = b
End Function


Public Sub Line_Out()
Dim H As Double
If Pointer < 0 Then
    Pointer = 0
End If
If Bkeydown = True Then
    Pointer = UBound(Fdata, 1)
    If Not Pointer = 0 And BoverReceive = True And Incepton = False Then
        a = Pointer + Showbuff
        ReDim Preserve Showdata(a)
                
        H = Pointer
        For i = 1 To Pointer
            Form1.Timer1.Interval = 10000
            
            If (Fdata(i) And &H80) = &H80 Then                                         'BIT.7=1 高电平， BIT.7=0 低电平
                If Y1 = 1200 Then
                    Form1.Picture1.Line (X2, 1200)-(X2, 2400), RGB(0, 0, 255)
                End If
                Y2 = 2400: Y1 = 2400
            Else
                If Y1 = 2400 Then
                    Form1.Picture1.Line (X2, 2400)-(X2, 1200), RGB(0, 0, 255)
                End If
                Y2 = 1200: Y1 = 1200
            End If
            X1 = X2
            X2 = X1 + (Fdata(i) And &H7F) * TSize
            
            
            If X2 > 10000 Then                                              '超过屏幕显示范围
                Dim T, D As Long
                                                                                '  T = GetMessageTime
                Form1.Picture1.AutoRedraw = False
                If Not Form1.MSComm1.PortOpen Then
                    If Form1.Option1(1).Value = True Then
                        Call clr_rmtp
                    End If
                    Form1.MSComm1.CommPort = intPort
                    Form1.MSComm1.Settings = strSet
                    Form1.MSComm1.PortOpen = True
                End If
                                
                T = T + 10000
                Do While D < T                                         '延迟100ms
                    Form1.Timer1.Interval = 10000
                    Call Delay(10000, 1000)
                    D = D + 1                                                                ' D = GetMessageTime
                Loop
                Form1.Picture1.AutoRedraw = True
                If Key_pause = True Then                                    '暂停键按下
                    Call Key_run
                    Bpause = False
                    Exit For
                End If
                Form1.Picture1.Cls
                X1 = 0
                X2 = 0
            End If
            
            
            If Not Pointer = 0 Then
                Pointer = Pointer - 1
            End If
    
            Form1.Picture1.Line (X1, Y1)-(X2, Y2), RGB(0, 0, 255)
    
            'Form1.Text1.Text = Form1.Text1.Text & Fdata(i)
            If Bkeydown = False Then
                Call ST
                Exit For
            End If
            
            '保存当前页面数据
            Showdata(Showbuff) = Fdata(i)
            Showbuff = Showbuff + 1
            
            If Incepton = True Then
                Call ST
                Exit For
            End If
            If Key_pause = True Then
                Bpause = True
            End If
       Next i
        BoverReceive = False
               
    Else
            If X2 > 10000 Then
                H = UBound(Fdata, 1)
                ReDim Fdata(0)
                
                If Key_pause = True And Bpause = True Then                                   '暂停键按下
                    Bpause = False
                    Call Key_run
                    GoTo Een_1
                End If
                
                Call INIT
            End If
            
  
            If Y1 = 2400 Then
                Form1.Picture1.Line (X2, 2400)-(X2, 1200), RGB(0, 0, 255)
            End If
                X2 = X1 + 800
                Form1.Picture1.Line (X1, Y1)-(X2, Y2), RGB(0, 0, 255)
                X1 = X2: Y1 = Y2
            End If
Een_1:
End If
Form1.Timer1.Interval = 100
Form1.Timer1.Enabled = True
End Sub

Public Sub Ctrl_View()
Dim a As Long
    a = UBound(Showdata, 1)
    If RightArrow = True Then
        If a < 100 Then
            If Show_Num < a - 5 Then
                Show_Num = Show_Num + 5
            End If
        ElseIf a < 1000 Then
            If Show_Num < a - 10 Then
                Show_Num = Show_Num + 10
            End If
        Else
            If Show_Num < a - 20 Then
                Show_Num = Show_Num + 20
            End If
        End If
    ElseIf Leftarrow = True Then
        If a < 100 Then
            If Show_Num > 5 Then
                Show_Num = Show_Num - 5
            End If
        ElseIf a < 1000 Then
            If Show_Num > 10 Then
                Show_Num = Show_Num - 10
            End If
        Else
            If Show_Num >= 20 Then
                Show_Num = Show_Num - 20
            End If
        End If
    End If
    RightArrow = False
    Leftarrow = False
End Sub

Public Sub ST()
Dim Q As Double, P As Double
    Q = 0
    For P = i + 1 To Pointer
        Fdata(Q) = Fdata(P)
        Q = Q + 1
    Next P
    Pointer = Pointer - i
End Sub

Public Sub Picture2_Show()
    Form1.Picture1.Visible = False
    Form1.Picture2.Visible = True
    Form1.Picture2.AutoRedraw = True
    Form1.Picture2.Cls
    X3 = 0
    X4 = 0
    Y3 = 0
    Y4 = 0
    
        For i = Show_Num To Showbuff - 1
            If (Showdata(i) And &H80) = &H80 Then                                    'BIT.7=1 高电平， BIT.7=0 低电平
                If Y3 = 1200 Then
                    Form1.Picture2.Line (X4, 1200)-(X4, 2400), RGB(0, 0, 255)
                End If
                Y4 = 2400: Y3 = 2400
            Else
                If Y3 = 2400 Then
                    Form1.Picture2.Line (X4, 2400)-(X4, 1200), RGB(0, 0, 255)
                End If
                Y4 = 1200: Y3 = 1200
            End If
            X3 = X4
            
    
            X4 = X3 + (Showdata(i) And &H7F) * TSize
            If X4 > 10000 Then
                 Form1.Picture2.Line (X3, Y3)-(10000, Y4), RGB(0, 0, 255)
                 Exit For
            End If
    
            Form1.Picture2.Line (X3, Y3)-(X4, Y4), RGB(0, 0, 255)
    
        Next i
End Sub

Public Sub Delay(a As Double, b As Double)
Dim i As Double
For b = 0 To 0
    For i = 0 To 50
        Form1.Timer1.Interval = 10000
        a = a + 1
    Next i
    a = 0
Next b
End Sub

Public Sub Key_run()
    If Bkeydown = False Then
        Form1.Command1.Caption = "pause"                        '运行键按下
        Form1.Line1.Visible = False
        Form1.Line2.Visible = False
        Form1.Line3.Visible = False
        Form1.Line4.Visible = False
        Form1.Picture2.Visible = False
        Form1.Picture1.Visible = True
      '  Key_pause = False
        Form1.Command11.Enabled = False
        Form1.Command12.Enabled = False
    Else
        Form1.Command1.Caption = "run"                          '暂停键按下
     '   Form1.Command11.Enabled = True
     '   Form1.Command12.Enabled = True
    End If
    Bkeydown = Not Bkeydown
End Sub