viewer.frm

一个用VB编写的串口通信程序

      Picture         =   "viewer.frx":005B
      Top             =   0
      Width           =   360
   End
   Begin VB.Image red 
      Height          =   360
      Left            =   -180
      Picture         =   "viewer.frx":075D
      Top             =   0
      Width           =   360
   End
End
Attribute VB_Name = "Viewer"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False

Dim tempvalue As Integer
Dim mintime, minvalue, detT As Single
Dim scanscreen As Integer
Private Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal X As Long, ByVal Y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long

Private Sub adc_Change()
Call drawdata
End Sub

Private Sub bdc_Change()
Call drawdata
End Sub

Private Sub blue_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = 1 Then
    blue.Left = blue.Left + X - blue.Width / 2
    
    If blue.Left < -180 Then
     blue.Left = -180
    End If
    If blue.Left > viewerwnd.Width Then
     blue.Left = viewerwnd.Width - 180
    End If
    
    cursureline1.X1 = blue.Left + blue.Width / 2 - 30
    cursureline1.X2 = blue.Left + blue.Width / 2 - 30
End If
time12.Caption = (cursureline1.X1 - cursureline2.X1) / mintime
Call displayinfo
End Sub

Private Sub Form_Load()
'//////reset window size and poision
retvalue = SetWindowPos(Me.hwnd, -1, Me.CurrentX, Me.CurrentY, 505, 420, &H40)
Me.Move (Screen.Width - Me.Width) / 2, (Screen.Height - Me.Height) / 2

Me.Height = 6690
'//////draw the face
drawbg

mintime = 50
minvalue = 1
detT = 150
List2.ListIndex = 2
List1.ListIndex = 1

adc.Max = 2048
adc.Min = -2048
bdc.Max = 2048
bdc.Min = -2048


End Sub
Sub drawbg()


For i = 1 To Fix(viewerwnd.Height / 500)
    Load bgline(i)
    bgline(i).X1 = -32767
    bgline(i).X2 = 32767
    bgline(i).Y1 = i * 500
    bgline(i).Y2 = i * 500
    bgline(i).Visible = True
    temp = i
Next i
For i = 1 To Fix(65535 / 500)
    Load bgline(i + temp)
    bgline(i + temp).X1 = i * 500 - 32737
    bgline(i + temp).X2 = i * 500 - 32767
    bgline(i + temp).Y1 = 0
    bgline(i + temp).Y2 = viewerwnd.Height
    bgline(i + temp).Visible = True
Next i
End Sub

Private Sub left_Click()
If lineadjust.Value >= 5 Then
lineadjust.Value = lineadjust.Value - 5
End If
End Sub

Private Sub Form_Unload(Cancel As Integer)
If controllor.state = False Then
    Cancel = 0
Else
    Me.Visible = False
    Cancel = 1
End If
End Sub

Private Sub right_Click()
If lineadjust.Value <= lineadjust.Max - 5 Then
lineadjust.Value = lineadjust.Value + 5
End If
End Sub




Private Sub List1_Scroll()
Dim temp As Single

Select Case List1.TopIndex
        Case 0
        temp = 1
        Case 1
        temp = 10
        Case 2
        temp = 100
        Case 3
        temp = 1000
End Select

detT = 15 * temp
mintime = 500 / temp

End Sub



Private Sub List2_Scroll()
Dim temp As Single
Select Case List2.TopIndex
        Case 0
        temp = 0.01
        Case 1
        temp = 0.1
        Case 2
        temp = 1
        Case 3
        temp = 10
        Case 4
        temp = 100
End Select

minvalue = temp
End Sub

Private Sub red_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = 1 Then
    red.Left = red.Left + X - red.Width / 2

    If red.Left < -180 Then
     red.Left = 180
    End If
    If red.Left > viewerwnd.Width Then
     red.Left = viewerwnd.Width - 180
    End If
    
    cursureline2.X1 = red.Left + red.Width / 2 - 30
    cursureline2.X2 = red.Left + red.Width / 2 - 30
End If
time12.Caption = (cursureline1.X1 - cursureline2.X1) / mintime
Call displayinfo
End Sub
Public Sub drawdata()
'首先判断数据指针的位置，并根据设置计算用于绘图的数据段
'viewerwnd.Width内的网格宽度为500点，对应于所输入的时间基准
'detT=时间基准*(viewerwnd.Width/500=15)
'detT=时间基准*15
'mintime 定义了每个时间单位转换成的点数
'minvalue 定义了每个值所代表的点数
Dim tempt1, tempt2 As Integer
Dim tempv1, tempv2 As Integer
Dim i As Integer

If viewerstate = 1 Then
   If receiveonly.Value = 0 Then
   
    Do While datapointer_out - formerpointer >= detT
        formerpointer = formerpointer + detT
        laterpointer = formerpointer
        viewerwnd.Cls
    Loop
    
        i = laterpointer + 1
        Do While i <= datapointer_out
            tempt1 = (i - formerpointer - 1) * mintime
            tempt2 = (i - formerpointer) * mintime
            tempv1 = zerovalue - (outdata(i - 1, 2)) * minvalue + bdc.Value
            tempv2 = zerovalue - (outdata(i, 2)) * minvalue + bdc.Value
            
            If tempt1 <= cursureline1.X1 And tempt2 >= cursureline1.X1 Then
                currentvalueb1.Caption = outdata(i - 1, 2)
            End If
            If tempt1 <= cursureline2.X1 And tempt2 >= cursureline2.X1 Then
                currentvalueb2.Caption = outdata(i - 1, 2)
            End If
            
            viewerwnd.Line (tempt1, tempv1)-(tempt2, tempv2), vbBlack
            i = i + 1
         Loop
    '////////////////////////////////////////以下是绘制的收到数据部分
    
         i = laterpointer + 1
        Do While i <= datapointer_out And i - formerpointer <= detT
            If indata(i, 2) > -1 Then
                tempt1 = (prevalidata - formerpointer) * mintime
                tempt2 = (i - formerpointer) * mintime
                tempv1 = zerovalue - (indata(prevalidata, 2)) * minvalue + adc.Value
                tempv2 = zerovalue - (indata(i, 2)) * minvalue + adc.Value
                
                If tempt1 <= cursureline1.X1 And tempt2 >= cursureline1.X1 Then
                    currentvaluea1.Caption = indata(i, 2)
                End If
                If tempt1 <= cursureline2.X1 And tempt2 >= cursureline2.X1 Then
                    currentvaluea2.Caption = indata(i, 2)
                End If
                
                viewerwnd.Line (tempt1, tempv1)-(tempt2, tempv2), vbRed
                prevalidata = i
            End If
            i = i + 1
         Loop
        laterpointer = datapointer_out
        viewmove.Max = formerpointer
        viewmove.Value = formerpointer
   Else
'//////////////////////////////////////only receive/////////////////////////
        If indata(datapointer_in, 1) - indata(formerpoiinter, 1) > detT Then
            formerpoiinter = laterpointer
        End If
        
        i = laterpointer_in
        
        Do While i + 1 < datapointer_in
                tempt1 = (indata(i, 1) - indata(formerpointer, 1)) * mintime
                tempt1 = (indata(i + 1, 1) - indata(formerpointer, 1)) * mintime
                tempv1 = zerovalue - (indata(i, 2)) * minvalue + adc.Value
                tempv2 = zerovalue - (indata(i + 1, 2)) * minvalue + adc.Value
                
                If tempt1 <= cursureline1.X1 And tempt2 >= cursureline1.X1 Then
                    currentvaluea1.Caption = indata(i, 2)
                End If
                If tempt1 <= cursureline2.X1 And tempt2 >= cursureline2.X1 Then
                    currentvaluea2.Caption = indata(i, 2)
                End If
                
                viewerwnd.Line (tempt1, tempv1)-(tempt2, tempv2), vbRed
        Loop
                
                laterpointer = datapointer_in
                viewmove.Max = formerpointer
                viewmove.Value = formerpointer

   End If
ElseIf viewerstate = 2 Then
'//////////////////////////////////////////////////////////////////////////////////
'//////////////////////////////////////////////////////////////////////////////////
    formerpointer = viewmove.Value
    laterpointer = viewmove.Value
    viewerwnd.Cls
 If receiveonly.Value = 1 Then
'////////////////////////////////////////////////////////////////
        i = laterpointer_in
        
        Do While i + 1 < datapointer_in And indata(i, 1) - indata(formerpointer, 1) < detT
                tempt1 = (indata(i, 1) - indata(formerpointer, 1)) * mintime
                tempt1 = (indata(i + 1, 1) - indata(formerpointer, 1)) * mintime
                tempv1 = zerovalue - (indata(i, 2)) * minvalue + adc.Value
                tempv2 = zerovalue - (indata(i + 1, 2)) * minvalue + adc.Value
                
                If tempt1 <= cursureline1.X1 And tempt2 >= cursureline1.X1 Then
                    currentvaluea1.Caption = indata(i, 2)
                End If
                If tempt1 <= cursureline2.X1 And tempt2 >= cursureline2.X1 Then
                    currentvaluea2.Caption = indata(i, 2)
                End If
                
                viewerwnd.Line (tempt1, tempv1)-(tempt2, tempv2), vbRed
        Loop
Else
  i = formerpointer + 1
          
          Do While i <= datapointer_out And i - formerpointer < detT
            tempt1 = (i - formerpointer - 1) * mintime
            tempt2 = (i - formerpointer) * mintime
            tempv1 = zerovalue - (outdata(i - 1, 2)) * minvalue + bdc.Value
            tempv2 = zerovalue - (outdata(i, 2)) * minvalue + bdc.Value
            
            If tempt1 <= cursureline1.X1 And tempt2 >= cursureline1.X1 Then
                currentvalueb1.Caption = outdata(i - 1, 2)
            End If
            If tempt1 <= cursureline2.X1 And tempt2 >= cursureline2.X1 Then
                currentvalueb2.Caption = outdata(i - 1, 2)
            End If
            
            viewerwnd.Line (tempt1, tempv1)-(tempt2, tempv2), vbBlack
            i = i + 1
         Loop
         
          i = formerpointer
          Do While indata(i, 2) = -1 And i > 0
            i = i - 1
          Loop
          prevalidata = i
          
'/////////////////////////////////////////////////////////////////////
          i = formerpointer + 1
        Do While i <= datapointer_in And i - formerpointer < detT
            If indata(i, 2) > -1 Then
                tempt1 = (prevalidata - formerpointer) * mintime
                tempt2 = (i - formerpointer) * mintime
                tempv1 = zerovalue - (indata(prevalidata, 2)) * minvalue + adc.Value
                
                tempv2 = zerovalue - (indata(i, 2)) * minvalue + adc.Value
                
                If tempt1 <= cursureline1.X1 And tempt2 >= cursureline1.X1 Then
                    currentvaluea1.Caption = indata(i, 2)
                End If
                If tempt1 <= cursureline2.X1 And tempt2 >= cursureline2.X1 Then
                    currentvaluea2.Caption = indata(i, 2)
                End If
                
                viewerwnd.Line (tempt1, tempv1)-(tempt2, tempv2), vbRed
                prevalidata = i
            End If
            i = i + 1
         Loop

  End If
End Sub



Private Sub viewmove_Scroll()
Call drawdata
End Sub

Sub displayinfo()
On Error GoTo marks::
If viewerstate = 2 Then
    Call drawdata
End If
marks::
End Sub