主窗口.frm

一个基于FPGA的串口程序

         ScaleWidth      =   975
         TabIndex        =   19
         Top             =   480
         Width           =   975
      End
      Begin VB.PictureBox Pic发送 
         Appearance      =   0  'Flat
         AutoSize        =   -1  'True
         BackColor       =   &H80000005&
         BorderStyle     =   0  'None
         ForeColor       =   &H80000008&
         Height          =   900
         Index           =   2
         Left            =   5160
         MouseIcon       =   "主窗口.frx":7947
         MousePointer    =   99  'Custom
         Picture         =   "主窗口.frx":7C51
         ScaleHeight     =   900
         ScaleWidth      =   975
         TabIndex        =   18
         Top             =   480
         Width           =   975
      End
      Begin VB.PictureBox Pic发送 
         Appearance      =   0  'Flat
         AutoSize        =   -1  'True
         BackColor       =   &H80000005&
         BorderStyle     =   0  'None
         ForeColor       =   &H80000008&
         Height          =   900
         Index           =   1
         Left            =   6120
         MouseIcon       =   "主窗口.frx":8422
         MousePointer    =   99  'Custom
         Picture         =   "主窗口.frx":872C
         ScaleHeight     =   900
         ScaleWidth      =   975
         TabIndex        =   17
         Top             =   480
         Width           =   975
      End
      Begin VB.PictureBox Pic发送 
         Appearance      =   0  'Flat
         AutoSize        =   -1  'True
         BackColor       =   &H80000005&
         BorderStyle     =   0  'None
         ForeColor       =   &H80000008&
         Height          =   900
         Index           =   0
         Left            =   7080
         MouseIcon       =   "主窗口.frx":8EFD
         MousePointer    =   99  'Custom
         Picture         =   "主窗口.frx":9207
         ScaleHeight     =   900
         ScaleWidth      =   975
         TabIndex        =   7
         Top             =   480
         Width           =   975
      End
   End
   Begin MSCommLib.MSComm MSComm1 
      Left            =   4080
      Top             =   4800
      _ExtentX        =   794
      _ExtentY        =   794
      _Version        =   327680
      DTREnable       =   -1  'True
      OutBufferSize   =   1024
      RThreshold      =   1
      RTSEnable       =   -1  'True
      SThreshold      =   1
      InputMode       =   1
   End
   Begin VB.Frame Fra串口设置 
      Caption         =   "通讯端口 --- 波特率 ----- 串口开关"
      Height          =   615
      Left            =   480
      TabIndex        =   2
      Top             =   4560
      Width           =   3375
      Begin VB.ComboBox CobPort 
         Height          =   300
         ItemData        =   "主窗口.frx":99D8
         Left            =   120
         List            =   "主窗口.frx":99F7
         TabIndex        =   5
         Text            =   "COM1"
         Top             =   240
         Width           =   1095
      End
      Begin VB.ComboBox CobBote 
         Height          =   300
         ItemData        =   "主窗口.frx":9A31
         Left            =   1320
         List            =   "主窗口.frx":9A5F
         TabIndex        =   4
         Text            =   "9600"
         Top             =   240
         Width           =   1095
      End
      Begin VB.CheckBox Chk串口开关 
         Height          =   255
         Left            =   2760
         TabIndex        =   3
         Top             =   240
         Width           =   375
      End
   End
   Begin VB.CommandButton Cmd发送 
      Caption         =   "发送"
      Height          =   375
      Left            =   9000
      TabIndex        =   1
      Top             =   1320
      Width           =   1215
   End
   Begin VB.CommandButton Com退出 
      Caption         =   "退出"
      Height          =   372
      Left            =   9000
      TabIndex        =   0
      Top             =   3240
      Width           =   1215
   End
   Begin VB.Image Img绿灯亮 
      Height          =   960
      Left            =   5520
      Picture         =   "主窗口.frx":9ABC
      Top             =   4560
      Visible         =   0   'False
      Width           =   960
   End
   Begin VB.Image Img绿灯暗 
      Height          =   960
      Left            =   4560
      Picture         =   "主窗口.frx":A4D2
      Stretch         =   -1  'True
      Top             =   4560
      Visible         =   0   'False
      Width           =   960
   End
   Begin VB.Image Img绿暗 
      Height          =   900
      Left            =   8400
      Picture         =   "主窗口.frx":AD32
      Top             =   4560
      Visible         =   0   'False
      Width           =   975
   End
   Begin VB.Image Img红暗 
      Height          =   900
      Left            =   6480
      Picture         =   "主窗口.frx":DB64
      Top             =   4560
      Visible         =   0   'False
      Width           =   975
   End
   Begin VB.Image Img绿亮 
      Height          =   900
      Left            =   9360
      Picture         =   "主窗口.frx":E335
      Top             =   4560
      Visible         =   0   'False
      Width           =   975
   End
   Begin VB.Image Img红亮 
      Height          =   900
      Left            =   7440
      Picture         =   "主窗口.frx":EB50
      Top             =   4560
      Visible         =   0   'False
      Width           =   975
   End
End
Attribute VB_Name = "主窗口"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim ShArr() As Byte         '接收,字符串可以被赋予能调整大小的字节数组
Dim FaArr(0) As Byte        '发送,字节数组在存储二进制数据时很有用
Dim FaBit(7) As Boolean     '发送位数组
Dim JsBit(7) As Boolean     '接收位数组
Option Explicit

Private Sub MSComm1_OnComm()
Dim i
    If MSComm1.CommEvent = 2 Then
        ShArr = MSComm1.Input   '从接收缓冲区取二进制数据
        字节转换为位 ShArr(0), JsBit()
        For i = 0 To 7
            Pic接收(i).Picture = IIf(JsBit(i), Img绿灯亮, Img绿灯暗)
        Next i
    End If
End Sub

Private Sub Pic发送_Click(Index As Integer)
    FaBit(Index) = Not FaBit(Index)
    Pic发送(Index).Picture = IIf(FaBit(Index), Img红亮.Picture, Img红暗.Picture)
    Cmd发送_Click
End Sub

Private Sub 字节转换为位(字节 As Byte, ByRef 位数组() As Boolean)
Dim i, v As Byte
    v = 字节
    For i = 0 To 7
        位数组(i) = IIf((v And 1) = 1, 1, 0)
        v = v \ 2
    Next i
End Sub

Private Function 位转换为字节(位() As Boolean) As Byte
Dim i, v
    v = 0
    For i = 7 To 0 Step -1
        v = v * 2
        If 位(i) = True Then
            v = v + 1
        End If
    Next i
    位转换为字节 = v
End Function

Private Sub Cmd发送_Click()
    FaArr(0) = 位转换为字节(FaBit)
    MSComm1.Output = FaArr
End Sub

Private Sub Com退出_Click()
    End
End Sub

Private Sub Form_Load()
    串口开关 True
End Sub

Function 串口开关(开串口 As Boolean) As Boolean
Dim CommOpen As Boolean, Ret As Boolean
On Error GoTo Aaaa
    Ret = False                 '有错
    If MSComm1.PortOpen <> 开串口 Then
        MSComm1.PortOpen = 开串口
    End If
    Ret = True                  '无错
Aaaa:
    CommOpen = MSComm1.PortOpen
    Cmd发送.Enabled = CommOpen
    Fra发送.Enabled = CommOpen
    Chk串口开关 = IIf(CommOpen, 1, 0)
    串口开关 = Ret
End Function

Private Sub Chk串口开关_Click()
    串口开关 CBool(Chk串口开关)
End Sub

Private Sub CobBote_Click()
    串口开关 False
    MSComm1.Settings = CobBote + ",n,8,1"
End Sub

Private Sub CobPort_Click()
    串口开关 False
    MSComm1.CommPort = Right(CobPort, 1)
End Sub