www.pudn.com > VBPmscomm.rar > Form1.frm, change:2014-01-02,size:8854b


VERSION 5.00 
Object = "{648A5603-2C6E-101B-82B6-000000000014}#1.1#0"; "MSCOMM32.OCX" 
Begin VB.Form Form1  
   Caption         =   "Form1" 
   ClientHeight    =   4950 
   ClientLeft      =   60 
   ClientTop       =   450 
   ClientWidth     =   7185 
   LinkTopic       =   "Form1" 
   ScaleHeight     =   4950 
   ScaleWidth      =   7185 
   StartUpPosition =   3  '窗口缺省 
   Begin VB.ComboBox Combo1  
      Height          =   300 
      Left            =   1200 
      TabIndex        =   9 
      Top             =   480 
      Width           =   975 
   End 
   Begin VB.ComboBox Combo2  
      Height          =   300 
      Left            =   1200 
      TabIndex        =   8 
      Top             =   1080 
      Width           =   975 
   End 
   Begin VB.ComboBox Combo3  
      Height          =   300 
      Left            =   1200 
      TabIndex        =   7 
      Top             =   1680 
      Width           =   975 
   End 
   Begin VB.ComboBox Combo4  
      Height          =   300 
      Left            =   1200 
      TabIndex        =   6 
      Top             =   2280 
      Width           =   975 
   End 
   Begin VB.ComboBox Combo5  
      Height          =   300 
      Left            =   1200 
      TabIndex        =   5 
      Top             =   2880 
      Width           =   975 
   End 
   Begin VB.CommandButton Command1  
      Caption         =   "打开串口" 
      Height          =   375 
      Left            =   960 
      TabIndex        =   4 
      Top             =   3480 
      Width           =   1215 
   End 
   Begin VB.TextBox Text1  
      Height          =   1935 
      Left            =   3120 
      MultiLine       =   -1  'True 
      ScrollBars      =   2  'Vertical 
      TabIndex        =   3 
      Top             =   720 
      Width           =   3855 
   End 
   Begin VB.TextBox Text2  
      Height          =   375 
      Left            =   3120 
      TabIndex        =   2 
      Top             =   3480 
      Width           =   3855 
   End 
   Begin VB.CommandButton Command2  
      Caption         =   "发送" 
      Height          =   375 
      Left            =   5760 
      TabIndex        =   1 
      Top             =   3000 
      Width           =   1095 
   End 
   Begin VB.CheckBox Check1  
      Caption         =   "十六进制显示" 
      Height          =   375 
      Left            =   5040 
      TabIndex        =   0 
      Top             =   120 
      Width           =   1455 
   End 
   Begin VB.Timer Timer1  
      Enabled         =   0   'False 
      Interval        =   1000 
      Left            =   2400 
      Top             =   1200 
   End 
   Begin MSCommLib.MSComm MSComm1  
      Left            =   2280 
      Top             =   240 
      _ExtentX        =   1005 
      _ExtentY        =   1005 
      _Version        =   393216 
      DTREnable       =   -1  'True 
   End 
   Begin VB.Label Label1  
      Caption         =   "串口号:" 
      Height          =   375 
      Left            =   240 
      TabIndex        =   16 
      Top             =   480 
      Width           =   855 
   End 
   Begin VB.Label Label2  
      Caption         =   "波特率:" 
      Height          =   375 
      Left            =   240 
      TabIndex        =   15 
      Top             =   1080 
      Width           =   855 
   End 
   Begin VB.Label Label3  
      Caption         =   "数据位:" 
      Height          =   375 
      Left            =   240 
      TabIndex        =   14 
      Top             =   1680 
      Width           =   735 
   End 
   Begin VB.Label Label4  
      Caption         =   "奇偶位:" 
      Height          =   375 
      Left            =   240 
      TabIndex        =   13 
      Top             =   2280 
      Width           =   735 
   End 
   Begin VB.Label Label5  
      Caption         =   "停止位:" 
      Height          =   375 
      Left            =   240 
      TabIndex        =   12 
      Top             =   2880 
      Width           =   855 
   End 
   Begin VB.Shape Shape1  
      Height          =   255 
      Left            =   360 
      Top             =   3600 
      Width           =   255 
   End 
   Begin VB.Label Label6  
      Caption         =   "接收区:" 
      Height          =   375 
      Left            =   3240 
      TabIndex        =   11 
      Top             =   240 
      Width           =   975 
   End 
   Begin VB.Label Label7  
      Caption         =   "发送区:" 
      Height          =   255 
      Left            =   3240 
      TabIndex        =   10 
      Top             =   3120 
      Width           =   975 
   End 
End 
Attribute VB_Name = "Form1" 
Attribute VB_GlobalNameSpace = False 
Attribute VB_Creatable = False 
Attribute VB_PredeclaredId = True 
Attribute VB_Exposed = False 
Public blind_x As Integer 
Public blind_y As Integer 
Public flag2 As Boolean 
Dim i As Long 
Dim flag  As Boolean 
Private Sub Check1_Click() 
If flag = False Then 
flag = True 
Else 
flag = False 
End If 
End Sub 
Public Sub Command1_Click() 
If MSComm1.PortOpen = True Then 
MSComm1.PortOpen = False 
Command1.Caption = "打开串口" 
Shape1.BackStyle = 1 
Shape1.BackColor = vbBlack 
Exit Sub 
End If 
If Not MSComm1.PortOpen Then 
MSComm1.CommPort = Combo1.ListIndex + 1 
MSComm1.RThreshold = 1 
MSComm1.inputlen = 0 
MSComm1.Settings = Trim$(Combo2.Text) & "," & Left$(Combo4.Text, 1) & "," & Trim$(Combo3.Text) & Trim$(Combo5.Text) 
MSComm1.EOFEnable = False 
If flag = True Then 
MSComm1.InputMode = comInputModeBinary 
Else 
MSComm1.InputMode = comInputModeText 
End If 
MSComm1.InBufferCount = 0 
MSComm1.OutBufferCount = 0 
MSComm1.SThreshold = 0 
MSComm1.InBufferSize = 1024 
MSComm1.PortOpen = True 
Command1.Caption = "关闭串口" 
Shape1.BackStyle = 1 
Shape1.BackColor = vbRed 
End If 
End Sub 
Private Sub Command2_Click() 
On Error Resume Next 
If Command1.Caption = "打开串口" Then 
MsgBox "请打开串口" 
End If 
Dim outputlen As Long 
Dim i As Long 
MSComm1.OutBufferCount = 0 
If flag2 = True Then 
MSComm1.Output = Val(Text2.Text) 
Else 
MSComm1.Output = Text2.Text 
End If 
If flag = True Then 
MSComm1.InputMode = comInputModeBinary 
Else 
MSComm1.InputMode = comInputModeText 
End If 
End Sub 
Private Sub Form_Load() 
Dim i As Integer, Settings As String, Offset As Integer 
flag = False 
flag2 = False 
Check1.Value = 0 
For i = 1 To 16 
    Combo1.AddItem "Com" & Trim$(str$(i)) 
Next i 
Combo2.AddItem "300" 
Combo2.AddItem "600" 
Combo2.AddItem "1200" 
Combo2.AddItem "2400" 
Combo2.AddItem "4800" 
Combo2.AddItem "9600" 
Combo2.AddItem "19200" 
Combo2.AddItem "28800" 
Combo2.AddItem "38400" 
Combo2.AddItem "56000" 
Combo2.AddItem "57600" 
Combo2.AddItem "115200" 
Combo2.AddItem "128000" 
Combo2.AddItem "256000" 
Combo3.AddItem "4" 
Combo3.AddItem "5" 
Combo3.AddItem "6" 
Combo3.AddItem "7" 
Combo3.AddItem "8" 
Combo4.AddItem "Even" 
Combo4.AddItem "Odd" 
Combo4.AddItem "None" 
Combo4.AddItem "Mark" 
Combo4.AddItem "Space" 
Combo5.AddItem "1" 
Combo5.AddItem "1.5" 
Combo5.AddItem "2" 
Combo1.ListIndex = 0 
Combo2.ListIndex = 8 
Combo3.ListIndex = 4 
Combo4.ListIndex = 2 
Combo5.ListIndex = 0 
Shape1.BackStyle = 1 
Shape1.BackColor = vbBlack 
End Sub 
Private Sub MSComm1_OnComm() 
Dim inputlen As Integer 
Dim inbyte() As Byte 
Dim indata As String 
Dim j As Long 
Select Case MSComm1.CommEvent 
       Case comEvReceive 
         inputlen = MSComm1.InBufferCount 
       If flag = True Then 
            inbyte = MSComm1.Input 
             For j = 0 To inputlen - 1 Step 1 
              If (inbyte(j) < 16) Then 
              indata = indata & "0" & Hex(inbyte(j)) 
              Else 
               indata = indata & Hex(inbyte(j)) 
              End If 
             Next j 
          Text1.Text = Text1.Text & indata 
       Else 
         indata = MSComm1.Input 
         Text1.Text = Text1.Text & indata 
      End If 
      i = i + inputlen 
      If i >= 25 Then 
     ' Text1.Text = Text1.Text & Chr(13) 
      Timer1.Enabled = True 
      i = 0 
      End If 
End Select 
End Sub 
Private Sub Timer1_Timer() 
Dim a As String 
Dim b As String 
Dim c As String 
a = Mid$(Text1.Text, 25, 2) 
b = Mid$(Text1.Text, 27, 2) 
c = b & a 
blind_x = transfer(c) 
blind_x = blind_x / 4 
a = Mid$(Text1.Text, 29, 2) 
b = Mid$(Text1.Text, 31, 2) 
c = b & a 
blind_y = transfer(c) 
blind_y = blind_y / 4 
flag2 = True 
Text1.Text = "" 
Timer1.Enabled = False 
End Sub 
Private Function transfer(str As String) As Integer 
Dim n As Integer 
Dim k As Integer 
Dim ch As String 
n = Len(str) 
For k = 0 To n - 1 
 ch = Asc(Mid(str, n - k, 1)) 
 If 65 <= ch And ch <= 70 Then 
 transfer = transfer + (ch - 65 + 10) * 16 ^ k 
 ElseIf 48 <= ch And ch <= 57 Then 
 transfer = transfer + (ch - 48) * 16 ^ k 
 End If 
 Next k 
End Function 
 

2018无需申请注册送58体验金