首页 VB串口通信程序代码

VB串口通信程序代码

举报
开通vip

VB串口通信程序代码vb中怎样用mscomm控件实现串口通信 本问分两部分均来自 第一部分jessezappy(晶晶) ================================================================================== If   MSComm1.PortOpen   Then   MSComm1.PortOpen   =   False   MSComm1.CommPort   =   1     '假定是用COM1口   '   设定传输速率等,可依照您的需...

VB串口通信程序代码
vb中怎样用mscomm控件实现串口通信 本问分两部分均来自 第一部分jessezappy(晶晶) ================================================================================== If   MSComm1.PortOpen   Then   MSComm1.PortOpen   =   False   MSComm1.CommPort   =   1     '假定是用COM1口   '   设定传输速率等,可依照您的需求更改   MSComm1.Settings   =   "9600,N,8,1"     MSComm1.PortOpen   =   True             '---------初始化Modem-------------   MSComm1.Output   =   "ATZ"   MSComm1.Output   =   "AT&F"   MSComm1.Output   =   "ATE0"   MSComm1.Output   =   "ATM1"   MSComm1.Output   =   "ATQ0"   MSComm1.Output   =   "ATV0"   '--------------------------拨号-------------   MSComm1.Output   ="ATDT163"       '拨163   '---------------------------接通后   MSComm1.Output   ="SDFJDKSJLKFA"       '发送字符串   '---------------------   Private   Sub   MSComm1_OnComm()               '用串口事件捕捉数据..   If   MSComm1.InBufferCount   Then   '   通讯埠中假如有资料的话,   则读取进来   InStringB   =   InStringB   &   MSComm1.Input   '   如果资料中有   Chr(13)   和   Chr(10)   的话,   则显示出来   If   InStr(InStringB,   vbCrLf)   Then   instring   =   instring   &   InStringB   AddText   Text3,   InStringB,   False   InStringB   =   ""   End   If   End   If   END   SUB   '-------------------------挂断--------   MSComm1.PortOpen   =   False         '这个挂断方法不能适用所有MODEM,我正在研究...通用办法 ================================================================================================ 第二部分: =========================================================================== 最后借你一篇文章看,作者不是我,里面的不一定都对..   '-----------------------------------------------------------   VB   Mscomm控件应用   江苏戚墅堰机车车辆厂设计处(213011)   李秉璋     --------------------------------------------------------------------------------   Visual   Basic   6.0(以下简称VB)   是一种功能强大、简单易学的程序设计语言。它不但保留了原先Basic语言的全部功能,而且还增加了面向对象程序设计功能。它不仅可以方便快捷地编制适用于数据处理、多媒体等方面的程序,而且利用ActiveX控件MSComm还能十分方便地开发出使用计算机串口的计算机通信程序。本文结合计算机通信的两个例子,详细介绍如何在VB中使用MSComm控件。     处理方式     MSComm控件提供了两种处理通信的方式:一种为事件驱动方式,该方式相当于一般程序设计中的中断方式。当串口发生事件或错误时,MSComm控件会产生OnComm事件,用户程序可以捕获该事件进行相应处理。本文的两个例子均采用该方式。另一种为查询方式,在用户程序中设计定时或不定时查询MSComm控件的某些属性是否发生变化,从而确定相应处理。在程序空闲时间较多时可以采用该方式。     常用属性和方法     利用MSComm控件实现计算机通信的关键是理解并正确设置MSComm控件众多属性和方法。以下是MSComm控件的常用属性和方法:     ●Commport:设置或返回串口号。     ●Settings:以字符串的形式设置或返回串口通信参数。     ●Portopen:设置或返回串口状态。     ●InputMode:设置或返回接收数据的类型。     ●Inputlen:设置或返回一次从接收缓冲区中读取字节数。     ●InBufferSize:设置或返回接收缓冲区的大小,缺省值为1024字节。     ●InBufferCount:设置或返回接收缓冲区中等待计算机接收的字符数。     ●Input:从接收缓冲区中读取数据并清空该缓冲区,该属性设计时无效,运行时只读。     ●OutBufferSize:设置或返回发送缓冲区的大小,缺省值为512字节。     ●OutBufferCount:设置或返回发送缓冲区中等待计算机发送的字符数。     ●Output:向发送缓冲区发送数据,该属性设计时无效,运行时只读。     ●Rthreshold:该属性为一阀值。当接收缓冲区中字符数达到该值时,MSComm控件设置Commevent属性为ComEvReceive,并产生OnComm事件。用户可在OnComm事件处理程序中进行相应处理。若Rthreshold属性设置为0,则不产生OnComm事件。例如用户希望接收缓冲区中达到一个字符就接收一个字符,可将Rthreshold设置为1。这样接收缓冲区中接收到一个字符,就产生一次OnComm事件。     ●Sthreshold:该属性亦为一阀值。当发送缓冲区中字符数小于该值时,MSComm控件设置Commevent属性为ComEvSend,并产生OnComm事件。若Sthreshold属性设置为0,则不产生OnComm事件。要特别注意的是仅当发送缓冲区中字符数小于该值的瞬间才产生OnComm事件,其后就不再产生OnComm事件。例如Sthreshold设置为3,仅当发送缓冲区中字符数从3降为2时,MSComm控件设置Commevent属性为ComEvSend,同时产生OnComm事件,如发送缓冲区中字符始终为2,则不会再产生OnComm事件。这就避免了发送缓冲区中数据未发送完就反复发生OnComm事件。     ●CommEvent:这是一个非常重要的属性。该属性设计时无效,运行时只读。一旦串口发生通信事件或产生错误,依据产生的事件和错误,MSComm控件为CommEvent属性赋不同的代码,同时产生OnComm事件。用户程序就可在OnComm事件处理程序中针对不同的代码,进行相应的处理。CommEvent属性的代码、常数及含义参见 关于同志近三年现实表现材料材料类招标技术评分表图表与交易pdf视力表打印pdf用图表说话 pdf 1及表2。     表1   CommEvent通信事件   代码   常数   含义     1   ComEvReceive   接受到Rthreshold个字符。该事件将持续产生,直到用Input属性从接受缓冲区中读取并删除字符。     2   ComEvSend   发送缓冲区中数据少于Sthreshold个,说明串口已经发送了一些数据,程序可以用Output属性继续发送数据。     3   ComEvCTS   Clear   To   Send信号线状态发生变化。     4   ComEvDSR   Data   Set   Ready信号线状态从1变到0。     5   ComEvCD   Carrier   Detect信号线状态发生变化。     6   ComEvRing   检测到振铃信号。     7   ComEvEOF   接受到文件结束符。     表2   CommEvent通信错误   代码   常数   含义     1001   ComEvntBreak   接受到一个中断信号。     1002   ComEvntCTSTO   Clear   To   Send信号超时。     1003   ComEvntDSRTO   Data   Set   Ready信号超时。     1004   ComEvntFrame   帧错误。     1006   ComEvntOverrun   串口超速。     1007   ComEvntCDTO   载波检测超时。     1008   ComEvntRxOver   接受缓冲区溢出,缓冲区中已没有空间。     1009   ComEvntRxParity   奇偶校验错。     1010   ComEvntTxFull   发送缓冲区溢出,缓冲区中已没有空间。     1011   ComEvntDCB   检索串口的设备控制块时发生错误。     实例1:计算机拨号     在一些实际应用中经常需要使用计算机拨号。下面这个例子利用MSComm控件操作Modem进行拨号,实现串口通信。     实现步骤:     1.建窗体     ●添加一个MSComm控件,用来建立与串口的连接;     ●添加一个Text控件,Name属性为Txttel,用来输入电话号码;     ●添加3个CommandButton控件,Name属性分别为DialButton、CancellButton、QuitButton,分别用来实现拨号、中止拨号、中止程序;     ●添加一个Label控件,用来显示所有与拨号有关的信息。窗体见图1。     2.设置MSComm控件属性     ●InBufferSize=1024;     ●Inputlen=0;     ●InputMode=0;     ●Rthreshold=2;     ●RTSEnable=True;     ●Settings=“9600,N,8,1”;     ●Sthreshold=0。     因为每一台计算机的串口使用状态都不会一样。为使程序具有通用性,在窗体的Load方法中首先进行串口测试,找到第一个可用串口后再进行设置。     3.程序功能     程序根据输入的电话号码进行拨号,Modem正常拨号后,提示用户摘机,准备通话。     图1   电话拨号实例     4.主要方法与事件代码     '设置可用串口     Private   Sub   Form_Load()       On   Error   GoTo   error_open     For   i   =   1   To   4     MSComm1.CommPort   =   i     MSComm1.PortOpen   =   True     '设置可用的第一个串口     On   Error   GoTo   0       Exit   Sub     error_resume:     Next     error_open:     Resume   error_resume     End   Sub     Private   Sub   DialButton_Click()     Dim   Number$,   Temp$     Number$   =   Trim$(Txttel.Text)     If   Number$   =   “"   Then     MsgBox   “请输入电话号码"     Txttel.SetFocus     Exit   Sub     End   If     DialButton.Enabled   =   False     QuitButton.Enabled   =   False     DialString$   =“ATDT”+   Number$   +   “;”   +   vbCr     '清除接收缓冲区     MSComm1.InBufferCount   =0       '拨电话号码     MSComm1.Output   =   DialString$       Lblmessage.Caption   =   “正在拨号码   -”+Number$     DialButton.Enabled   =   True     QuitButton.Enabled   =   True     End   Sub     Private   Sub   MSComm1_OnComm()     Select   Case   MSComm1.CommEvent     Case   comEvReceive     '读取串口数据     COMBUF=COMBUF   +   MSComm1.Input       lc   =   InStr(1,   COMBUF,   “OK”)     If   lc   =   0   Then   Exit   Sub     'Modem已正常拨号,返回OK     Lblmessage.Caption   =   “请您摘下电话机,     准备通话”       Case   comEvSend     End   Select     End   Sub     Private   Sub   CancelButton_Click()     '断开与调制解调器的连接     MSComm1.Output   =   “ATH”   +   vbCr       End   Sub     实例2:实现来电显示     在一些实际应用中,需要显示并保存来电号码,并根据电话号码显示相应资料,比如小区物业管理和110报警等系统。     实现步骤:     1.创建窗体     ●添加一个MSComm控件,用来建立与串口的连接;     ●添加4个Option控件,用来确定使用的串口号;     ●添加4个Label控件,用来显示来电号码及日期时间;     ●添加一个ProgressBar控件,用来显示电话振铃次数;     ●为方便调试程序,添加一个Text控件Text   5,用来显示Modem传来的所有信息。窗体见图2。     图2   来电显示窗体     2.设置MSComm控件属性     ●InBufferSize=1024;     ●Inputlen=0;     ●InputMode=0;     ●Rthreshold=1;     ●RTSEnable=True;     ●Settings=“9600,N,8,1";     ●Sthreshold=0。     3.程序功能     程序首先初始化Modem,然后等待来电。当有来电时,MSComm产生OnComm事件。Modem送出的信息格式为“DATE   =   月日回车换行TIME   =   时分回车换行NMBR   =   电话号码回车换行”。在OnComm事件处理程序中对读入信息进行截取,截取电话号码后,以该电话号码为关键字,查询并显示数据库中有关信息。     4.主要方法与事件代码     '通用声明部分     Const   DEBFLG   =   1     Public   COMX,   BEEPNO,   HANGUP,PNLOC   As   Integer     Public   COMBUF,   COMLIN   As   String     Private   Sub   Form_Load()     '检测串行口     Dim   I,   C   As   Integer       COMX   =   0     COMBUF   =   “”     COMLIN   =   “”     BEEPNO   =   0     HANGUP   =   0     '正常运行程序,关闭右侧Text5     If   DEBFLG=   0   Then     Form1.Width   =   Form1.Width   -   Text5.Width     Text5.Enabled   =   False     Text5.Visible   =   False     End   If     On   Error   GoTo   ERROR_FORM_LOAD     '检测可用串口     For   C   =   1   To   4       If   MSComm1.PortOpen   Then   MSComm1.PortOpen   =   False     MSComm1.CommPort   =   C     If   Not   MSComm1.PortOpen   Then       MSComm1.PortOpen   =   True     If   MSComm1.PortOpen   Then   MSComm1.PortOpen   =   False     If   COMX   =   0   Then   COMX   =   C     FORM_LOAD_1:     Next   C     If   COMX   =   0   Then   End     On   Error   GoTo   0     Option1(COMX   -   1).Value   =   True     Exit   Sub     ERROR_FORM_LOAD:     Option1(C   -   1).Enabled   =   False     Resume   FORM_LOAD_1     End   Sub     '选择串行口     Private   Sub   Option1_Click(Index   As   Integer)     COMX   =   Index   +   1     Call   INIT_MODEM     End   Sub     '初试化Modem     Private   Sub   INIT_MODEM()     If   MSComm1.PortOpen   Then   MSComm1.PortOpen   =   False     MSComm1.CommPort   =   COMX     If   Not   MSComm1.PortOpen   Then   MSComm1.     PortOpen   =   True     MSComm1.Output   =   “AT#CID=1”   +   vbCr     '检查Modem命令是否完成     Call   CHK_MODEM       MSComm1.Output   =   “ATS0=0”   +   vbCr     End   Sub     '检查Modem命令是否完成     Private   Sub   CHK_MODEM()     Dim   T   As   Single     Dim   L   As   Integer     T   =   Timer     Do     COMBUF   =   COMBUF   +   MSComm1.Input     L   =   InStr(1,   COMBUF,“OK”)     Loop   Until   L   <>   0   Or   Timer   -   T   >   1     If   L   =   0   Then     Line1.Visible   =   True     Line2.Visible   =   True     Form1.Show     MsgBox   “MODEM未联机”,vbOKOnly+vbCritical,“测试MODEM”     Else     Line1.Visible   =   False     Line2.Visible   =   False     End   If     End   Sub     '串行口接收事件处理     Private   Sub   MSComm1_OnComm()     Dim   CH,   ST   As   String     Dim   LC   As   Integer     Select   Case   MSComm1.CommEvent     '接收到Rthreshold个字符     Case   comEvReceive       COMBUF   =   COMBUF   +   MSComm1.Input     '读取串口数据     Do       LC   =   InStr(1,   COMBUF,   Chr(10))     If   LC   =   0   Then   Exit   Do     COMLIN   =   Left(COMBUF,   LC)     COMBUF   =   Mid(COMBUF,   LC   +   1)     CH   =   Left(COMLIN,   1)     If   “   ”   <   CH   And   CH   <   Chr(127)   And   DEBFLG   =   1   Then     Text5.Text   =   Text5.Text   +   COMLIN     Text5.SelStart   =   Len(Text5.Text)     End   If     '截取来电号码,并显示     If   InStr(1,   COMLIN“NMBR=”)<>   0   Then     ST   =   Mid(COMLIN,   8)     Text2.Text=“   ”+Left$(ST,Len   (ST)   -2)   +   “   ”     Form1.WindowState   =   0     Timer1.Enabled   =   True     Call   BEEP_NO     '截取来电日期,并显示     ElseIf   InStr(1,   COMLIN,   “DATE   =   ”)   <>   0   Then     Text3.Text   =   Str(Year(DATE))   +   “.”+   Mid(COMLIN,   8,   2)   +   “.”   +   Mid(COMLIN,   10,   2)   +   “   ”     '截取来电时间,并显示     ElseIf   InStr(1,   COMLIN,   “TIME   =   ”)   <>   0   Then     Text4.Text   =   “   ”   +   Mid(COMLIN,   8,   2)   +   “:”   +   Mid(COMLIN,   10,   2)     '检测振铃个数     ElseIf   InStr(1,   COMLIN,   “RING”)   <>   0   Then     Call   BEEP_NO     If   HANGUP   =   1   Or   BEEPNO   =   15   Then   Call   HANG_UP     '检测是否停止振铃     ElseIf   Left(COMLIN,   3)   =   “000”   Then     BEEPNO   =   0     Timer1.Enabled   =   False     Form1.WindowState   =   1     ProgressBar1.Value   =   0     Frame3.Caption   =   “振铃数”     End   If     Loop     '其他事件处理     Case   comEvCTS     Case   comEvDSR     Case   comEvCD     Case   comEvRing     Case   comEventBreak     Call   INIT_MODEM     Case   Else     MsgBox   “串口接收事件号:”   &   MSComm1.CommEvent   &   “   ”,   vbOKOnly   +       vbCritical,   “测试串行口”     End   Select     End   Sub      、、、、、、、、、、、、、、、、、、、、、、、、、、、、、、、、、 VB控件MSComm串口通讯实例 vb 2007-04-04 21:26:46 阅读150 评论0   字号:大中小 订阅 ===================================================================================== 声明:本文摘自,新手单片机编程技术网对此文具有解释权  ===================================================================================== 现有电子秤一台,使用串口与计算机进行通讯。编写VB程序来访问串口,达到读取电子秤上显示的数据。该电子秤为BE01型仪表,输出为RS-232C标准接口,波特率为300-9600、偶校验、7个数据位、2个停止位。所有字符均发送11位ASCII码,一个起始位。在VB中与串口通讯需要引入控件MSComm串口通讯控件(在Microsoft Comm Control 6.0中)。具体程序如下:控件简称:MSC Dim Out(12) As Byte '接收var中的值 Dim var As Variant '接收MSC.input中的数值 Dim nRece As Integer '计算MSC.inputbuffer的个数 Dim i As Integer, j As Integer '随即变量,计算循环 **************************************************************************** Private Sub Form_Load() ClearText With MSC .CommPort = 1 '设置Com1为通信端口 .Settings = "9600,E,7,2" '设置通信端口参数 9600赫兹、偶校验、7个数据位、1个停止位.(这里需要进一步说明的是:.Setting=”BBBB,P,D,S”。 含义是:B:Baud Rate(波特率);P:Parity(奇偶);D:Data Bit;S:Stop Bit) .InBufferSize = 40 '设置缓冲区接收数据为40字节 .InputLen = 1 '设置Input一次从接收缓冲读取字节数为1 .RThreshold = 1 '设置接收一个字节就产生OnComm事件 End With End Sub **************************************************************************** Private Sub ClearText() Text3.Text = "" Text2.Text = "5" Text1.Text = "" End Sub Private Sub Command1_Click() ClearText ' nRece = 0 '计数器清零 With MSC .InputMode = comInputModeBinary '设置数据接收模式为二进制形式 .InBufferCount = 0 '清除接收缓冲区 If Not .PortOpen Then .PortOpen = True '打开通信端口 End If End With End Sub Private Sub MSC_OnComm() DelayTime ‘用来延续时间 ClearText With MSC Select Case .CommEvent '判断通信事件 Case comEvReceive: '收到Rthreshold个字节产生的接收事件 SwichVar 1 If Out(1) = 2 Then '判断是否为数据的开始标志 .RThreshold = 0 '关闭OnComm事件接收 End If Do DoEvents Loop Until .InBufferCount >= 3 '循环等待接收缓冲区>=3个字节 ' nRece = nRece + 1 For i = 2 To 12 SwichVar i Text1.Text = Text1.Text & Chr(Out(i)) Next Text1.Text = LTrim(Text1.Text) Text2.Text = Text2.Text & CStr(nRece) .RThreshold = 1 '打开MSComm事件接收 Case Else ' .PortOpen = False End Select End With End Sub **************************************************************************** Private Sub DelayTime() Dim bDT As Boolean Dim sPrevious As Single, sLast As Single bDT = True sPrevious = Timer (Timer可以计算从子夜到现在所经过的秒数,在Microsoft Windows中,Timer函数可以返回一秒的小数部分) Do While bDT If Timer - sPrevious >= 0.3 Then bDT = False Loop bDT = True End Sub (通信传输速率为9600bps,则最快速度1.04ms发送一个字节,仪表每秒发送50帧数据,每帧数据有4个字节,即每秒发送200个字节,平均5.0ms 发送一个字节,连续读取串口数据时要在程序中添加循环等待程序) Private Sub SwichVar(ByVal nNum As Integer) DelayTime var = Null var = MSC.Input Out(nNum) = var(0) End Sub (设置接收数据模式采用二进制形式,即 InputMode=comInputModeBinary,但用Input属性读取数据时,不能直接赋值给 Byte 类型变量,只能通过先赋值给一个 Variant 类型变量,返回一个二进制数据的数组,再转换保存到Byte类型数变量中。) Private Sub Text1_Change() Text3.Text = CText(Text1.Text) - CText(Text2.Text) End Sub **************************************************************************** Private Function CText(ByVal str As String) As Currency If str <> "" Then CText = CCur(Val(str)) Else CText = 0 End If End Function (仪表每秒发送50帧数据,微机收到一帧完整数据至少需要20 ms时间,然后再进行数据处理。如果微机在下一帧数据接收前即20ms内能将数据计算处理完毕,则接收缓冲区内只会保存有一帧数据,不会存有两帧以上数据,接收缓冲区的大小不会影响实时监测效果(接收缓冲区>4字节),这时完全可以实现实时监测或实时控制;如果微机在20ms内不能将数据计算处理完毕,接收缓冲区设置得又很大,在数据计算处理完毕前,接收缓冲区内就会保存有两帧以上数据,而且一次工作时间越长,缓冲区内滞留数据帧就越多,数据采集和数据处理之间产生逐渐增大的额外时间差,当接收缓冲区充满后,时间差不再增大,固定在某一值,部分数据因不能及时采集到接收缓冲区中,数据产生丢失现象,真实工作情况就会和微机处理结果产生较大的时间差,对实时监测和实时控制很不利,这种情况下接收缓冲区的大小就会影响实时监测效果,所以接收缓冲区设置不能过大,以保证数据处理的实时性。)  小结:本文所用的仪表为梅特勒公司出产的BE01型电子秤,其输出的每个编码均为标准的ASCII码。其他的仪表存在发射的编码中含有BCD压缩码,而且分为高低位,需要接收后对其进行解码换算,之后还要将高位和低位数字进行相加,即可以将其BCD码换算成实数。另还存在误差的可能:判断最大值,仪表在刚开始工作时有干扰,会传导一些乱码,位移传感器有参数偏差,最大值一般都略大于50毫米,所以取51为极限最大值,取-51为极限最小值。暂时先写这些,当然其他的情况可以依此类推! -------------------------------------------------------------------------------------------------------______________ 用VB实现串口通信程序 2009-11-24 11:25 '===================================================================================== '              初始化串口子程序 '===================================================================================== Private Sub Comm_initial(Port As Byte, BaudRate As String, ParityBit As String, DataBit As Integer, StopBit As Integer) On Error GoTo ErrorTrap                  ' 错误则跳往错误处理 If MSComm1.PortOpen = True Then MSComm1.PortOpen = False                          ' 先判断串口是否打开,如果打开则先关闭 MSComm1.CommPort = Port                                                          ' 设定端口 MSComm1.Settings = BaudRate & "," & ParityBit & "," & DataBit & "," & StopBit    ' 设置波特率,无校验,8位数据位,1位停止位 MSComm1.InBufferSize = 1024                                                      ' 设置接收缓冲区为1024字节 MSComm1.OutBufferSize = 4096                                                     ' 设置发送缓冲区为4096字节 MSComm1.InBufferCount = 0                                                        ' 清空输入缓冲区 MSComm1.OutBufferCount = 0                                                       ' 清空输出缓冲区 MSComm1.SThreshold = 1                                                           ' 发送缓冲区空触发发送事件 MSComm1.RThreshold = 1                                                           ' 每X个字符到接收缓冲区引起触发接收事件 MSComm1.OutBufferCount = 0                                                       ' 清空发送缓冲区 MSComm1.InBufferCount = 0                                                        ' 滑空接收缓冲 MSComm1.PortOpen = True                                                          ' 打开串口 If MSComm1.PortOpen = True Then Txtstatus.Text = "STATUS:" & cboport.Text & " OPEND," & cbobps.Text & "," & Left(CboParity.Text, 1) & "," & 8 & "," & 1 Else Txtstatus.Text = "STATUS:COM Port Cloced"                                  ' 串口没打开时,提示串口关闭状态 End If Exit Sub ErrorTrap:                                                                          ' 错误处理 Select Case Err.Number Case comPortAlreadyOpen                                                         ' 如果串口已经打开,则提示 MsgBox "此串口已打开", 49, "Modbus通讯程序" CloseCom Case Else MsgBox "没有发现此串口或被占用", 49, "Modbus通讯程序" CloseCom End Select Err.Clear End Sub '===================================================================================== '               串口设置子程序 '===================================================================================== Private Sub Comm_reSet(Port As Byte, BaudRate As String, ParityBit As String, DataBit As Integer, StopBit As Integer) On Error GoTo ErrorHint                                                         ' 错误则跳往错误处理 If MSComm1.PortOpen = True Then MSComm1.PortOpen = False                          ' 先判断串口是否打开,如果打开则先关闭 MSComm1.CommPort = Port                                                          ' 设定端口 MSComm1.Settings = BaudRate & "," & ParityBit & "," & DataBit & "," & StopBit    ' 设置波特率,无校验,8位数据位,1位停止位 MSComm1.PortOpen = True                                                          ' 打开串口 If MSComm1.PortOpen = True Then Txtstatus.Text = "STATUS:" & cboport.Text & " OPEND," & cbobps.Text & "," & Left(CboParity.Text, 1) & "," & 8 & "," & 1 Else Txtstatus.Text = "STATUS:COM Port Cloced"                                  ' 串口状态显示 End If    Exit Sub ErrorHint:                                                                          ' 错误处理 Select Case Err.Number Case comPortAlreadyOpen                                                         ' 如果串口已经打开,则提示 MsgBox "串口冲突,请更改串口后再试", vbExclamation, "Modbus通讯设置" CloseCom                                                                    ' 调用关闭串口函数 Case Else MsgBox "设置失败,请确认连接后重试", vbExclamation, "Modbus通讯设置" CloseCom                                                                    ' 调用关闭串口函数 End Select Err.Clear                                                                      ' 清除 Err 对象的属性 End Sub '===================================================================================== '             串口开关子程序 '===================================================================================== Private Sub OpenCom() '打开串口 On Error GoTo Err If MSComm1.PortOpen = True Then MSComm1.PortOpen = False                          ' 先判断串口是否打开,如果打开则先关闭 Call Comm_reSet(Val(Mid(cboport.Text, 4, 1)), cbobps.Text, Left(CboParity.Text, 1), 8, 1)             ' 串口设置 If MSComm1.PortOpen = True Then Txtstatus.Text = "STATUS:" & cboport.Text & " OPEND," & cbobps.Text & "," & Left(CboParity.Text, 1) & "," & 8 & "," & 1 Else Txtstatus.Text = "STATUS:COM Port Cloced"                                  ' 串口状态显示         End If Err: End Sub '=====================关闭串口===================== Private Sub CloseCom() On Error GoTo Err If MSComm1.PortOpen = True Then MSComm1.PortOpen = False                          ' 先判断串口是否打开,是,则关闭 Txtstatus.Text = "STATUS:COM Port Cloced"                                      ' 串口状态显示 Err: End Sub Private Sub Form_Load() cmdtest.Enabled = False If MSComm1.PortOpen = True Then MSComm1.PortOpen = False            ' 先判断串口是否打开,如果打开则先关闭 Call Comm_initial(Val(Mid(cboport.Text, 4, 1)), cbobps.Text, Left(CboParity.Text, 1), 8, 1)   ' 初始化串口 MSComm1.InputMode = comInputModeBinary      '通过二进制方式读取数据 End Sub '===================串口设置按钮======================= Private Sub cmdset_Click() TxtReceive.Text = "" If MSComm1.PortOpen = True Then MSComm1.PortOpen = False Call OpenCom End If End Sub '===================================接收前CRC校验============================================== Private Sub prerecv() Dim m As Integer Dim n As Integer Dim crcdata() As Byte Dim ValCRC As Long Dim Jyh0 As Byte Dim Jyh1 As Byte m = Len(Replace(TxtReceive.Text, Space(1), Space(0))) ReDim dt(m / 2 - 1) As Byte ReDim crcdata(m / 2 - 3) As Byte For n = 0 To m / 2 - 1 dt(n) = Val("&H" + Mid(Replace(TxtReceive.Text, Space(1), Space(0)), n * 2 + 1, 2)) Next n For n = 0 To m / 2 - 3 crcdata(n) = dt(n) Next n ValCRC = CRC(crcdata)                                                           '计算收到数据的crc校验码 Jyh0 = ValCRC Mod 256                                                           '取crc校验码的高位 Jyh1 = Int(ValCRC / 256)                                                        '取crc校验码的低位 If (dt(m / 2 - 2) = Jyh0 And dt(m / 2 - 1) = Jyh1) Then                     '如果接收到的数据crc校验正确,则继续 pd = True TxtReceive.Text = "" Else pd = False End If End Sub '===================================发送前生成CRC码============================================== Private Sub presend() Dim m As Integer Dim n As Integer Dim data() As Byte Dim crcdata() As Byte Dim ValCRC As Long Dim Jyh0 As Byte Dim Jyh1 As Byte m = Len(Replace(TxtSend.Text, Space(1), Space(0))) If m >= 2 Then ReDim data(m / 2 - 1) As Byte For n = 0 To m / 2 - 1 data(n) = Val("&H" + Mid(Replace(TxtSend.Text, Space(1), Space(0)), n * 2 + 1, 2)) Next n ValCRC = CRC(data)                                                           '计算待发送数据的crc校验码 Jyh0 = ValCRC Mod 256                                                           '取crc校验码的高位 Jyh1 = Int(ValCRC / 256)                                                        '取crc校验码的低位 TxtSend.Text = TxtSend.Text & Hex(Jyh0) & Hex(Jyh1)                                           '将校验码加在待发送数据的末尾 End If End Sub '==================================================================================== '                             数据发送 '==================================================================================== Private Sub dataSend() On Error Resume Next Dim outdata As String Dim outputLen As Integer                                                        ' 发送数据长度 Dim SendArr() As Byte                                                           ' 发送数组 Dim TemporarySave As String                                                     ' 数据暂存 Dim dataCount As Integer                                                        ' 数据个数计数 Dim i As Integer                                                                ' 局部变量 outdata = Replace(TxtSend.Text, Space(1), Space(0))                             ' 先去掉空格 outdata = UCase(outdata) outputLen = Len(outdata)                                                        ' 数据长度 For i = 0 To outputLen TemporarySave = Mid(outdata, i + 1, 1)                                      ' 取一位数据 If (Asc(TemporarySave) >= 48 And Asc(TemporarySave) <= 57) Or (Asc(TemporarySave) >= 65 And Asc(TemporarySave) <= 70) Then dataCount = dataCount + 1 Else Exit For Exit Sub End If Next If dataCount Mod 2 <> 0 Then                                                    ' 判断十六进制数据是否为双数 dataCount = dataCount - 1                                                   ' 不是双数,则减1 End If outdata = Left(outdata, dataCount) ReDim SendArr(dataCount / 2 - 1)                                               ' 重新定义数组长度 For i = 0 To dataCount / 2 - 1 SendArr(i) = Val("&H" + Mid(outdata, i * 2 + 1, 2))                         ' 取出数据转换成十六进制并放入数组中 Next TxtSend.Text = "" MSComm1.Output = SendArr                                                         ' 发送数据 End Sub '==================================================================================== '                               数据接收 '==================================================================================== Private Sub dataReceive() Dim ReceiveArr() As Byte                                                         ' 接收数据数组 Dim receiveData As String                                                       ' 数据暂存 Dim Counter As Integer                                                          ' 接收数据个数计数器 Dim i As Integer                                                                ' 循环变量 If (MSComm1.InBufferCount > 0) Then Counter = MSComm1.InBufferCount                                            ' 读取接收数据个数 receiveData = ""                                                            ' 清缓冲 ReceiveArr = MSComm1.Input                                                   ' 数据放入数组 For i = 0 To (Counter - 1) Step 1                                           ' '将接收缓存区的数据依次写入数据暂存变量 If (ReceiveArr(i) < 16) Then receiveData = receiveData & "0" + Hex(ReceiveArr(i))                 ' 小于16,前面加0后写入 Else receiveData = receiveData & Hex(ReceiveArr(i))                      '大于16,直接写入 End If Next i TxtReceive.Text = TxtReceive.Text + receiveData                             ' 存储接收的数据到TxtReceive TxtReceive.SelStart = Len(TxtReceive.Text)                                  ' 显示光标位置 End If If Len(Replace(TxtReceive.Text, Space(1), Space(0))) = 62 Then Call prerecv Call showdata End If End Sub Private Sub MSComm1_OnComm() On Error GoTo Err Select Case MSComm1.CommEvent                                                    ' 每接收1个数就触发一次 Case comEvReceive Call dataReceive                                                     ' 调用数据接收函数 Case Else End Select Err: End Sub '===============CRC校验子程序===================== Public Function CRC(Brr() As Byte) As Long Dim i As Integer, j As Integer Dim TempVal As Long Dim YWval As Long Dim LSB As Integer TempVal = &HFFFF& For i = 0 To UBound(Brr()) TempVal = TempVal Xor Brr(i) For j = 1 To 8 YWval = Int(TempVal / 2) LSB = TempVal Mod 2 If LSB = 1 Then YWval = YWval Xor &HA001& End If TempVal = YWval Next j Next i CRC = TempVal Mod 65536 End Function 扩展的曲线图程序 数据可保存于数据库也可保存于文本文件,各自实现代码不同. 使用TIMER控件定时保存数据代码: Private Sub Timer3_Timer() If Label5.Caption <> CStr(Time$) Then Label5.Caption = Time$ sum_zj = sum_zj + 1 '校准 If sum_zj >= 60 Then sum_zj = sum_zj - 60 '每分钟记录一组数据 Adodc1.Recordset.AddNew Adodc1.Recordset(0) = shiyan_sj(0) Adodc1.Recordset(1) = Mid(Date$, 3, 2) & Mid(Date$, 6, 2) & Mid(Date$, 9, 2) & "-" & Time$ 'Mid(Time$, 1, 2) & Mid(Time$, 4, 2) & Mid(Time$, 7, 2) '记录time Adodc1.Recordset(2) = Val(Label3(0).Caption)  '记录数据 Adodc1.Recordset(3) = Val(Label3(1).Caption)  '记录数据 Adodc1.Recordset.Update End If End If End Sub 只要数据能保存于数据库.曲线图无须保存,通过数据检索画图: Private Sub numChaxun_Click() Adodc1.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "\HXMdi.mdb;Persist Security Info=False" Adodc1.RecordSource = "select * from jilu_sj where date like'%" & Text1.Text & "%' order by time" Adodc1.Refresh zsl = Adodc1.Recordset.RecordCount If zsl > 0 Then numPrint.Enabled = True numPrintData.Enabled = True numData.Enabled = True For i = 0 To zsl - 1 quexian(1, i) = Adodc1.Recordset(1) For j = 2 To 9 quexian(j, i) = Adodc1.Recordset(j) Next j Adodc1.Recordset.MoveNext Next i Picture2.Height = 6765 Picture1.Visible = False Text2 = Right(quexian(1, 0), 8) Text3 = Right(quexian(1, zsl - 1), 8) Text1.SelStart = 8 Text1.SelLength = 2 DataGrid1.Visible = False Adodc1.Visible = False Picture2.Height = 7245 Picture1.Visible = True Picture1.Cls colvb = vbBlue xx = 100 yy = 150 txt = "℃" wp = xp(colvb, xx, yy, txt) xx = 200 yy = 350 txt = "300" wp = xp(colvb, xx, yy, txt) yy = 1350 xx = 200 txt = "250" wp = xp(colvb, xx, yy, txt) xx = 200 yy = 2350 txt = "200" wp = xp(colvb, xx, yy, txt) yy = 3350 xx = 200 txt = "150" wp = xp(colvb, xx, yy, txt) yy = 4350 xx = 200 txt = "100" wp = xp(colvb, xx, yy, txt) yy = 5350 xx = 200 txt = " 50" wp = xp(colvb, xx, yy, txt) xx = 200 yy = 6350 txt = "0" wp = xp(colvb, xx, yy, txt) 'Time坐标 colvb = vbRed yy = 6500 xx = 400 txt = "0" wp = xp(colvb, xx, yy, txt) xx = 1300 txt = "2" wp = xp(colvb, xx, yy, txt) xx = 2200 txt = "4" wp = xp(colvb, xx, yy, txt) xx = 3100 txt = "6" wp = xp(colvb, xx, yy, txt) xx = 4000 txt = "8" wp = xp(colvb, xx, yy, txt) xx = 4900 txt = "10" wp = xp(colvb, xx, yy, txt) xx = 5800 txt = "12 小时" wp = xp(colvb, xx, yy, txt) xx = 6700 txt = "14" wp = xp(colvb, xx, yy, txt) xx = 7600 txt = "16" wp = xp(colvb, xx, yy, txt) xx = 8500 txt = "18" wp = xp(colvb, xx, yy, txt) xx = 9400 txt = "20" wp = xp(colvb, xx, yy, txt) xx = 10300 txt = "22" wp = xp(colvb, xx, yy, txt) xx = 11200 txt = "24" wp = xp(colvb, xx, yy, txt) '画格 Picture1.DrawWidth = 1 ' = dash Picture1.DrawStyle = 0 Picture1.ForeColor = vbBlue Picture1.DrawStyle = 2 For i = 0 To 12 Picture1.Line (450, 400 + i * 500)-(11300, 400 + i * 500) Next For i = 0 To 12 Picture1.Line (500 + i * 900, 400)-(500 + i * 900, 6400) Next Picture1.DrawStyle = 0 For j = 0 To zsl - 2 If Int(j / 30) - j / 30 = 0 Then Picture1.DrawWidth = 1 ' = dash Picture1.Line (j * 15 + 470, quexian(6, j) * -20 + 6400)-(j * 15 + 530, quexian(6, j) * -20 + 6400), vbGreen ', BF Picture1.Line (j * 15 + 500, quexian(6, j) * -20 + 6435)-(j * 15 + 500, quexian(6, j) * -20 + 6435), vbGreen ', BF Picture1.Line (j * 15 + 470, quexian(7, j) * -20 + 6435)-(j * 15 + 470, quexian(7, j) * -20 + 6435), vbBlue ', BF Picture1.Line (j * 15 + 470, quexian(7, j) * -20 + 6435)-(j * 15 + 530, quexian(7, j) * -20 + 6435), vbBlue ', BF Picture1.Line (j * 15 + 530, quexian(7, j) * -20 + 6435)-(j * 15 + 530, quexian(7, j) * -20 + 6385), vbBlue ', BF Picture1.Line (j * 15 + 470, quexian(7, j) * -20 + 6415)-(j * 15 + 530, quexian(7, j) * -20 + 6385), vbBlue  ', BF Picture1.DrawWidth = 2 ' = dash Picture1.Line (j * 15 + 475, quexian(4, j) * -20 + 6430)-(j * 15 + 525, quexian(4, j) * -20 + 6370), vbBlack Picture1.Line (j * 15 + 475, quexian(4, j) * -20 + 6370)-(j * 15 + 525, quexian(4, j) * -20 + 6430), vbBlack Picture1.DrawWidth = 1 ' = dash Picture1.Line (j * 15 + 500, quexian(3, j) * -20 + 6385)-(j * 15 + 469, quexian(3, j) * -20 + 6417), vbCyan ', BF Picture1.Line (j * 15 + 500, quexian(3, j) * -20 + 6385)-(j * 15 + 531, quexian(3, j) * -20 + 6417), vbCyan ', BF Picture1.Line (j * 15 + 469, quexian(3, j) * -20 + 6417)-(j * 15 + 531, quexian(3, j) * -20 + 6417), vbCyan ', BF Picture1.DrawWidth = 1 ' = dash Picture1.Line (j * 15 + 490, quexian(2, j) * -20 + 6380)-((j + 1) * 15 + 510, quexian(2, j + 1) * -20 + 6370), vbRed, BF Picture1.DrawWidth = 1 Picture1.Circle (j * 15 + 500, quexian(5, j) * -20 + 6400), 30, vbMagenta Else Picture1.DrawWidth = 1 Picture1.Line (j * 15 + 500, quexian(2, j) * -20 + 6400)-((j + 1) * 15 + 500, quexian(2, j + 1) * -20 + 6400), vbRed ', BF Picture1.Line (j * 15 + 500, quexian(3, j) * -20 + 6400)-((j + 1) * 15 + 500, quexian(3, j + 1) * -20 + 6400), vbCyan ', BF Picture1.Line (j * 15 + 500, quexian(4, j) * -20 + 6400)-((j + 1) * 15 + 500, quexian(4, j + 1) * -20 + 6400), vbBlack ', BF Picture1.Line (j * 15 + 500, quexian(5, j) * -20 + 6400)-((j + 1) * 15 + 500, quexian(5, j + 1) * -20 + 6400), vbMagenta ', BF Picture1.Line (j * 15 + 500, quexian(6, j) * -20 + 6400)-((j + 1) * 15 + 500, quexian(6, j + 1) * -20 + 6400), vbGreen ', BF Picture1.Line (j * 15 + 500, quexian(7, j) * -20 + 6400)-((j + 1) * 15 + 500, quexian(7, j + 1) * -20 + 6400), vbBlue ', BF End If Next Else numData.Enabled = False numPrint.Enabled = False numPrintData.Enabled = False End If End Sub 如下: 代码如下: Private Sub Form_Load() If MSComm1.PortOpen = True Then MSComm1.PortOpen = False Else End If Combo1.AddItem "COM1" Combo1.AddItem "COM2" Combo1.AddItem "COM3" Combo1.AddItem "COM4" Combo1.AddItem "COM5" Combo1.AddItem "COM6" Combo1.AddItem "COM7" Combo1.AddItem "COM8" Combo1.AddItem "COM9" Combo1.AddItem "COM10" Combo1.AddItem "COM11" Combo1.AddItem "COM12" Combo1.AddItem "COM13" Combo1.AddItem "COM14" Combo1.AddItem "COM15" Combo1.AddItem "COM16" Combo1.ListIndex = 2 Combo2.AddItem "256000" Combo2.AddItem "128000" Combo2.AddItem "115200" Combo2.AddItem "57600" Combo2.AddItem "38400" Combo2.AddItem "28800" Combo2.AddItem "19200" Combo2.AddItem "14400" Combo2.AddItem "12800" Combo2.AddItem "11520" Combo2.AddItem "9600" Combo2.AddItem "4800" Combo2.AddItem "2400" Combo2.AddItem "1200" Combo2.AddItem "600" Combo3.AddItem "无None" Combo3.AddItem "奇Odd" Combo3.AddItem "偶Even" Combo4.AddItem "4" Combo4.AddItem "5" Combo4.AddItem "6" Combo4.AddItem "7" Combo4.AddItem "8" Combo5.AddItem "1" Combo5.AddItem "2" MSComm1.CommPort = Combo1.ListIndex + 1 MSComm1.Settings = "9600,n,8,1" ComOpen.Caption = "打开串口" Shape1.FillColor = &HFFFFC0 End Sub Private Sub ComOpen_Click() On Error GoTo uerror      '发现错误跳转到错误处理 If ComOpen.Caption = "关闭串口" Then MSComm1.PortOpen = False ComOpen.Caption = "打开串口"  '按钮文字改变 Shape1.FillColor = &HFFFFC0    '灯颜色改变 Else MSComm1.PortOpen = True ComOpen.Caption = "关闭串口" Shape1.FillColor = &HFF End If Exit Sub uerror: msg$ = "无效端口号"          '错误显示 Title$ = "串口调试助手" X = MsgBox(msg$, 48, Title$)  '48标示显示警告图标 End Sub Private Sub MSComm1_OnComm() Dim BytReceived() As Byte Dim strBuff As String Dim i As Integer Select Case MSComm1.CommEvent    '事件发生 Case 2 Cls MSComm1.InputLen = 0     '读入缓冲区全部内容 strBuff = MSComm1.Input  '读入到缓冲区 Label10.Caption = Label10.Caption + Len(strBuff) '接收计数 If MSComm1.InputMode = comInputModeBinary Then BytReceived() = strBuff  '如果是二进制接收模式则进行数据处理,否则直接显示字符串 For i = 0 To UBound(BytReceived) If Len(Hex(BytReceived(i))) = 1 Then strData = strData & "0" & Hex(BytReceived(i)) & " " '如果只有一个字符,则前补0,如F显示0F,最后补空格 Else                                                    '方便显示观察如: 00 0F FE strData = strData & Hex(BytReceived(i)) & " " End If Next TextReceive = TextReceive & strData strData = "" Else TextReceive = TextReceive & strBuff End If End Select End Sub Private Sub ComSend1_Click()   '手动发送 Dim Temp(0) As Byte Dim strBuff As String If Option1.Value = True Then '如果显示16进制发送则进行16进制处理 ,这里只发送一个 Temp(0) = "&H" & TextSend MSComm1.Output = Temp  '发送一个16进制 Else strBuff = TextSend End If If MSComm1.PortOpen = False Then MsgBox "请打开串口" End If On Error GoTo uerror MSComm1.Output = strBuff Label11.Caption = Label11.Caption + Len(strBuff)  '发送计数 uerror: End Sub Private Sub ComSend2_Click() If ComSend2.Caption = "自动发送" Then ComSend2.Caption = "关闭自动发送" Timer1.Interval = TextTime.Text Timer1.Enabled = True Else ComSend2.Caption = "自动发送" Timer1.Enabled = False End If End Sub Private Sub ComClean1_Click() TextSend.Text = ""                      '清空发送窗口 End Sub Private Sub Option3_Click() MSComm1.InputMode = comInputModeBinary  '选择接收方式 End Sub Private Sub Option4_Click() MSComm1.InputMode = comInputModeText   '选择接收方式 End Sub Private Sub Timer1_Timer() Call ComSend1_Click      '定时调用手动发送 End Sub Private Sub Timer2_Timer() If Combo3 = "无None" Then MSComm1.Settings = Str(Combo2) + "N" + Str(Combo4) + Str(Combo5) ElseIf Combo3 = "奇Odd" Then MSComm1.Settings = Str(Combo2) + "O" + Str(Combo4) + Str(Combo5) ElseIf Combo3 = "偶Even" Then MSComm1.Settings = Str(Combo2) + "E" + Str(Combo4) + Str(Combo5) End If End Sub Private Sub Combo1_Click() If MSComm1.PortOpen = True Then  '如果串口打开先关闭后再进行其他操作 MSComm1.PortOpen = False End If MSComm1.CommPort = Combo1.ListIndex + 1 '读取com口号 End Sub Private Sub ComClean3_Click() Label10.Caption = 0 Label11.Caption = 0 End Sub Private Sub ComClean2_Click() TextReceive.Text = ""   '接收窗口 End Sub 功能上:实现了字符串的发送和接收,8位数据的十六进制发送和接收,有端口,波特率等设置。 缺点: 1:只可以发送两位十六进制数。 2:接收和发送的显示数据上有点不同步,十六进制的没有算进去。 3:没有TXT的文件发送和接收的功能。 需要源程序的,可下载本文的图片,下载后把图片的.jpg格式改为.rar格式就可以解压出来了。 附:MSComm控件的属性: 属性 说明 (Name) MSComm控件的名称 (自定义) 打开属性页 CommPort 获得或设置通讯端口号 DTREnable 决定在通讯过程中是否使数据终端机状态线有效。取值为:TrueFalse EOFEnable 获得或设置是否搜索EOF字符。取值为:TrueFalse Handshaking 获得或设置软件的握手 协议 离婚协议模板下载合伙人协议 下载渠道分销协议免费下载敬业协议下载授课协议下载 。取值为:0 comNone1 comXOnXoff2 comRTS3 comRTSXOnXOff InBufferSize 获得或设置接收缓冲区的大小,以字节数为单位。 Index 在对象数组中的编号 InputLen 获得或设置输入属性从接收缓冲区读出的字符数。 InputMode 获得或设置输入属性检索的数据类型。取值为:0 comInputModeText1 comInputModeBinary Left 距离容器左边框的距离 NullDiscard 决定是否将空字符串从端口传送到接收缓冲区。取值为:TrueFalse OutBufferSize 获得或设置传输缓冲区中的字符数 ParityReplace 获得或设置当出现奇偶校验错误时,用来替换数据流中无效字符的字符。 RThreshold 获得或设置要接受的字符数。 RTSEnable 决定能否使行有效。取值为:TrueFalse Settings 获得或设置波特率、奇偶校验、数据位和停止位参数。 SThreshold 获得或设置传输中所能允许的最小字符数 Tag 存储程序所需的附加数据 Top 距容器顶部边界的距离     将接到的数据赋值于全局变量,通过ADO数据控件连接数据库及表,用以下代码保存数据: Private Sub Timer1_Timer() If Label1.Caption <> CStr(Time$) Then Label1.Caption = Time$ sum_zj = sum_zj + 1 Text3 = sum_zj '校准 If sum_zj >= 3 Then sum_zj1 = sum_zj1 + 1 sum_zj = sum_zj - 3 Text4 = sum_zj1 Adodc1.Recordset.AddNew '每3秒记录一组数据 Adodc1.Recordset(0) = shiYAnH Adodc1.Recordset(1) = Mid(Time$, 1, 2) & Mid(Time$, 4, 2) & Mid(Time$, 7, 2) '记录time Adodc1.Recordset(2) = record_jm(0) '记录数据 Adodc1.Recordset(3) = record_jm(1) '记录数据 Adodc1.Recordset(4) = record_jm(2) '记录数据 Adodc1.Recordset(5) = record_jm(3) '记录数据 Adodc1.Recordset(6) = record_jm(4) '记录数据 Adodc1.Recordset(7) = record_jm(5) '记录数据 Adodc1.Recordset(8) = record_jm(6) '记录数据 Adodc1.Recordset(9) = record_jm(7) '记录数据 Adodc1.Recordset(10) = record_jm(8) '记录数据 Adodc1.Recordset(11) = record_jm(9) '记录数据 Adodc1.Recordset(12) = record_jm(10) '记录数据 Adodc1.Recordset(13) = record_jm(11) '记录数据 Adodc1.Recordset.Update End If End If End Sub Private Sub Timer2_Timer() Picture4.DrawStyle = 0 以下代码绘制实时曲线(6点): Picture4.DrawWidth = 3 ' = dash Picture4.Line (sum_z1 * 18 + 500, record_jm(0) * -150 + 7900)-(sum_z1 * 18 + 500, record_jm(2) * -150 + 7900), vbRed ', BF Picture4.Line (sum_z1 * 18 + 500, record_jm(1) * -150 + 7900)-(sum_z1 * 18 + 500, record_jm(3) * -150 + 7900), vbCyan ', BF Picture4.Line (sum_z1 * 18 + 500, record_jm(2) * -150 + 7900)-(sum_z1 * 18 + 500, record_jm(4) * -150 + 7900), vbBlack ', BF Picture4.Line (sum_z1 * 18 + 500, record_jm(3) * -150 + 7900)-(sum_z1 * 18 + 500, record_jm(5) * -150 + 7900), vbMagenta ', BF Picture4.Line (sum_z1 * 18 + 500, record_jm(4) * -150 + 7900)-(sum_z1 * 18 + 500, record_jm(6) * -150 + 7900), vbGreen ', BF Picture4.Line (sum_z1 * 18 + 500, record_jm(5) * -150 + 7900)-(sum_z1 * 18 + 500, record_jm(7) * -150 + 7900), vbBlue ', BF End Sub Private Sub Timer3_Timer() If Label32 <> CStr(Time$) Then 'Label1.Caption Label32.Caption = Time$ sum_z = sum_z + 1 Text31 = sum_z '校准 If sum_z >= 5 Then sum_z = sum_z - 5 sum_z1 = sum_z1 + 1 Text30 = sum_z1 End If End If End Sub 以下代码绘制曲线的坐标: Private Sub Form_Load() With Adodc1 Adodc1.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "\kongtiao\cartemp.mdb;Persist Security Info=False" Adodc1.RecordSource = "select * form car_bm" End With Text1 = "" Text2 = "": Text3 = "": Text4 = "": Text5 = "": Text6 = "": Text7 = "": Text12 = "" Text8 = "": Text9 = "": Text10 = "": Text11 = "" Text13 = "": Text14 = "": Text15 = "": Text16 = "" 'Load frmMain colvb = vbBlack xx = 100 yy = 150 txt = "℃" wp = xp(colvb, xx, yy, txt) xx = 200 yy = 350 txt = "50" wp = xp(colvb, xx, yy, txt) xx = 200 yy = 1850 txt = "40" wp = xp(colvb, xx, yy, txt) yy = 3350 xx = 200 txt = "30" wp = xp(colvb, xx, yy, txt) xx = 200 yy = 4850 txt = "20" wp = xp(colvb, xx, yy, txt) xx = 200 yy = 6350 txt = "10" wp = xp(colvb, xx, yy, txt) 'Time坐标 colvb = vbRed yy = 6500 xx = 400 txt = "0" wp = xp(colvb, xx, yy, txt) xx = 1480 txt = "5" wp = xp(colvb, xx, yy, txt) xx = 2560 txt = "10" wp = xp(colvb, xx, yy, txt) xx = 3640 txt = "15" wp = xp(colvb, xx, yy, txt) xx = 4720 txt = "20" wp = xp(colvb, xx, yy, txt) xx = 5800 txt = "25 min" wp = xp(colvb, xx, yy, txt) xx = 6880 txt = "30" wp = xp(colvb, xx, yy, txt) xx = 7960 txt = "35" wp = xp(colvb, xx, yy, txt) xx = 9040 txt = "40" wp = xp(colvb, xx, yy, txt) xx = 10120 txt = "45" wp = xp(colvb, xx, yy, txt) xx = 11200 txt = "50" wp = xp(colvb, xx, yy, txt) '画格 Picture1.DrawWidth = 1 ' = dash Picture1.DrawStyle = 0 Picture1.ForeColor = vbCyan For i = 0 To 39 Picture4.Line (450, 550 + i * 150)-(500, 550 + i * 150) Next Picture4.DrawStyle = 2 For i = 0 To 8 Picture4.Line (450, 400 + i * 750)-(11300, 400 + i * 750) Next For i = 0 To 15 Picture4.Line (450, 1000 + i * 300)-(500, 1000 + i * 300) Next For i = 0 To 10 Picture4.Line (500 + i * 1080, 400)-(500 + i * 1080, 6400) Next Picture4.DrawStyle = 0 End Sub 上述代码供参考. 论坛串口程序 VB中串口通讯的实现 一、概述 串口通讯作为一种古老而又灵活的通讯方式,被广泛地应用于PC间的通讯以及PC和单片机之间的通讯之中。提到串口通讯的编程,人们往往立刻想到C、汇编等对系统底层操作支持较好的编程语言以及大串繁琐的代码。 实际上,只要我们借助相关ActiveX控件的帮助,即使是在底层操作一向不被人看好的VB中,一样能够实现串口通讯,甚至其实现方法和C、汇编相比,要更加快捷方便。下面,笔者就介绍一下在VB中实现串口通讯的方法。 在VisualBasic中有一个名为MicrosoftCommunicationControl(简称MSComm)的通讯控件。我们只要通过对此控件的属性和事件进行相应编程操作,就可以轻松地实现串口通讯。下面,笔者就简要地介绍一下 MSComm控件的使用方法。 二、MSComm控件的主要属性、事件 1、MSComm的属性 由于MSComm控件属性很多,在此笔者仅介绍与实现串口通讯密切相关的核心属性。 Commport:设置通讯所占用的串口号。如设成1(默认值),表示对Com1进行操作。 Setting:对串口通讯的相关参数。包括串口通讯的比特率,奇偶校验,数据位长度、停止位等。其默认值是“9600,N,8,1”,表示串口比特率是9600bit/s,不作奇偶校验,8位数据位,1个停止位。 Portopen:设置串口状态,值为True时打开串口,值为False时关闭串口。 Input:从输入寄存器读取数据,返回值为从串口读取的数据内容,同时输入寄存器将被清空。 Ouput:发送数据到输出寄存器。 InBufferCount:设置输入寄存器所存储的字符数,当将其值设为0时,则输入寄存器将被清空。 InputMode:设置从输入寄存器中读取数据的形式。若值为0,则表示以文本形式读取;值为1,则表示以二进制形式读取。 OutBufferCount:设置输出寄存器所存储的字符数,当将其值设为0时,则输出寄存器将被清空。 RThreshold:设置在MSComm控件设置CommEvent属性为comEvReceive并产生OnComm事件之前要接受的字符数。 CommEvent属性:返回最近的通讯事件或错误。通过对它具体属性值的查询,我们就可以获得通讯事件和通讯错误的完整信息。当其值是comEvReceive时表示接收到数据。 2、MSComm的事件 除了公共事件之外,MSComm只有一个OnComm事件。当CommEvent属性值变化时将发生OnComm事件,指示发生一个通讯事件或错误。当我们设置Rtheshold属性值为0时,将使得捕获comEvReceive事件无效。 三、串口通讯编程实例 在完成了对MSComm控件的简要介绍之后,笔者就以实际程序为例,介绍一下串口通讯的具体实现方法。 1、PC机间的串口通讯 (1)、实现方法: A、新建一个窗体,在上面放两个Text控件、两个CommandButton控件和两个Label控件(如图1.bmp所示)。 具体见下表: 控件类型名称Caption属性作用   赞 2     l 2009-6-12 11:32 l 回复 l l 东软村长 l 54位粉丝 l 2楼 ------------------------------------------------------------------------------- TextText1-------输入所要发送的信息 TextText2-------显示接收到的信息 CommandButtonCommand1发送--------- CommandButtonCommand2退出--------- LabelLabel1发送的数据提示 LabelLabel2接收的数据提示 B、在控件工具箱中的空白处点击鼠标右键,在弹出的菜单中选择“部件”,在弹出的窗口中的控件列表中找到“MicrosoftCommControl”,将其选中,在点击“应用”、“关闭”,在控件工具栏中就会出现一个电话的小图标。 C、用串口线将两台电脑连接起来。您可以使用Com1对Com1的对应连接,也可以使用Com1和Com2的交叉连接。 本程序使用的是Com1对Com1的连接。 D、输入以下代码: PrivateSubCommand1_Click() '...发送数据 MSComm1.OutBufferCount=0'...清空输出寄存器 MSComm1.Output=Text1.Text'...发送数据 EndSub PrivateSubCommand2_Click() '...退出 UnloadMe EndSub PrivateSubForm_Load() '...初始化 MSComm1.CommPort=1'...使用Com1口 MSComm1.Settings="9600,n,8,1"'...设置通讯参数 MSComm1.PortOpen=True'...打开串口 EndSub PrivateSubMscomm1_Oncomm() '...通讯事件发生 SelectCaseMSComm1.CommEvent l 2009-6-12 11:32 l 回复       l l 东软村长 l 54位粉丝 l 3楼 CasecomEvReceive'...有接受事件发生 Text2.Text=MSComm1.Input'...接受显示数据 MSComm1.InBufferCount=0'...清空输入寄存器 EndSelect EndSub 2、PC机与单片机之间的通讯 PC机与单片机之间的通讯被广泛的用于工业、医疗测控等领域之中。在应用中,我们通常将单片机作为“感受器”和“效应器”,负责数据采集、响应计算机发出的指令对电路进行控制,有时也进行一些简单的运算,最后再将执行数据反馈给计算机处理。本程序将实现在PC机上输入一个0-255之间的整数,将此数据发送到单片机,单片机接收到数据后,将数据在显示管上显示,再将此数除以2,将得数返回给PC机。(运行效果如图3.BMP所示)其实现方法如下: A、同PC机间通讯的实现方法A-B。 B、连接电脑和单片机。注意!由于PC机端的RS232电平与单片机端TTL的并不不匹配,故应注意电平转换。 C、在VB中输入以下代码: PrivateSubMscomm1_Oncomm() '...通讯事件发生 DimindataAsVariant Dimbte(0)AsByte SelectCaseMSComm1.CommEvent CasecomEvReceive'...有接受事件发生 indata=MSComm1.Input '...注意!要通过MSComm控件发送或接收二进制数据必须用Variant类型的变量对二进 '...制Byte类型的变量进行转换! bte(0)=AscB(indata) Text2.Text=bte(0) MSComm1.InBufferCount=0'...清空输入寄存器 EndSelect EndSub PrivateSubCommand1_Click() '...发送数据 DimNumAsInteger Dimoutbte(0)AsByte Num=Val(Text1.Text) outbte(0)=CByte(Num) MSComm1.OutBufferCount=0'...清空输出寄存器 MSComm1.Output=outbte(0)'...发送数据 EndSub PrivateSubCommand2_Click() '...退出 UnloadMe EndSub PrivateSubForm_Load() '...初始化 MSComm1.CommPort=1'...使用Com1口 MSComm1.Settings="9600,n,8,1"'...设置通讯参数 MSComm1.PortOpen=True'...打开串口 EndSub D、单片机工作方式置于1,比特率设为9600bit/s。在单片机上,我们只得使用汇编语言编写,并且调用中断实现对串口数据的收发工作。源代码如下: PUSHPSW;将程序状态字压入堆栈 PUSHACC;将累加器压入堆栈 l 2009-6-12 11:32 l 回复 l l 东软村长 l 54位粉丝 l 4楼 CLREA;关闭系统中断 CLRRI;清除中断标志位 MOVA,SBUF;从接收寄存器中读取数据 MOV70H,A;分解数据百、十、个位并显示 MOVB,#100 DIVAB MOV52H,A;分解百位,送入存储器52H MOVA,B MOVB,#10 DIVAB MOV51H,A;分解十位,送入存储器51H MOV50H,B;分解个位,送入存储器50H MOVA,70H MOVB,#2 DIVAB;将接受的数据除以2 MOVSBUF,A;将得数发送到输出寄存器 ACALLDL1;延时保证数据完整发送 ACALLDL1 CLRRI;清除中断标志位 SETBEA;打开系统中断 POPACC;累加器出栈 POPPSW;程序状态字出栈 RETI;中断程序返回 3、编程环境 以上程序在Windows2000Professional,VisualBasic6.0企业版,AT89C52型单片机下调试通过。 四、总结 从以上程序可以看出,在VB中利用MSComm控件,可以快速开发出串口通讯程序,从而大大提高编程效率。 l 2009-6-12 11:32 l 回复     218.17.119.* 5楼 你上面的程序在初始化串口的时候要加上 MSComm1.RThreshold=1让他自动接受信息才正确吧.要不然怎么进行接收? l 2009-7-22 11:06 l 回复 l l zhengyajun2004 l 1位粉丝 l 6楼 好,谢谢 l 2010-7-11 21:58 l 回复       l l hilinx l 2位粉丝 l 7楼 关于VB串口通信,有一套非常好的技术资料,800M多,有源码,控件,文章,视频,书籍等,你在淘宝搜索“太阳雨VB串口资料”就可以找到,希望可以帮助到你。 l 2010-7-12 10:40 l 回复 l l 362019407 l 0位粉丝 l 8楼 haoren     从开始学Delphi到现在差不多一个月了,今天终于将自己一直想要的一个东东实现了,我的上位机学习先要告一段落了,接下来又要接着搞ARM了,所以趁此机会总结下。 一、工具的选择: 提到上位机开发,初学者最头痛的应该是选择那个开发工具好呢?VC、VB、Delphi、BCB、C#……当时我更是困惑,从没有搞过上位机,大学中倒是学过VB,可早就忘光光了。而且当时只知道VC,没听说过BCB和Delphi是什么东东。VC开始就被俺否决了,因为论坛上都说VC难,就没看到谁说VC简单的,再加上俺的编程功底本来就差,所以VC想都不敢想。VB的话,虽然资料众多,但是好像有些陈旧。然后在论坛上看到Delphi和BCB都简单易上手,而且使用者也很多,还有人说他们也不逊于VC,于是开始转向这两个。然后了解到这两个是同一家公司出的,只是Delphi以Pascal语言编程,BCB以C/C++编程,尽管很多人都说Pascal语言好学,我还是不敢想象从一门新的语言学起。于是选择BCB,用BCB6+ComPort控件写了个基本的串口通讯,真的很快,但是在BCB6中安装Iocomp画图控件时总安装不成功,所以不得不又硬着头皮转向了Delphi。真正开始用才发现Pascal语言不是很难学,基本上一边做一边学。Delphi的版本很多,现在都有Delphi2009了,不过还是Delphi7最为经典,使用者众多,交流方便。 二、说一下我做的这个东东: 前一段时间做了一个信号采集模块,采到的数据不知道对不对,只能一个个字节看或使用同事写好的Matlab程序验证,总是不太方便,想来想去自己也要写一个,顺便学习下什么是上位机。这个东东主要在于波形显示部分。串口发送接收使用控件很简单实现。使用的是24位AD、8个通道,而且还要任意时候可以关闭和显示某个通道。将采集到的数据转化进制,并跟参考电压计算后,显示出实际采样的电压值。串口控件采用开源的ComPort3.0,图形控件采用Iocomp控件。要写的程序不是很多,由于数学基础不咋的,搞得比较慢。 三、Delphi的编程思想: 面向对象的程序设计OOP(ObjectOrientedProgramming)是Delphi的精髓。那怎么理解这个面向对象呢?我们一般写的基于单片机的程序都是在一个main函数按顺序执行和中断驱动的,主要操作外设,写驱动,设置外设相关寄存器,响应外部和内部中断,或者直接使用厂家封装好的的固件库。而Dlephi操作的对象就是“对象”,Delphi中没有main函数,也不是顺序执行或中断驱动,而是事件驱动机制,通过操作对象的接口来编程,具体来说对象可能是某个按钮、文本框,也可能是某个可视化组件或者外部安装的控件。对象的接口就是:对象的属性、方法、事件。其实Delphi中的对象可以相当于单片机编程中的外设,其属性就相当于外设的某个寄存器,方法就是封装好的外设固件库,事件就相当于中断。其实熟悉后会发现比单片机的编程更简单。 四、学到的东西:不管做什么,结果如何,学到东西就好。这个过程中,由于语句简单、也不涉及算法,所以编程上可以说没啥长进,不过让我见识了自己的编程基础真的很薄弱,重新认识了很多基本的概念。 1、Byte和Char不分:开始总认为是一回事,后来查书才知道Byte是单字节无符号整型,取值范围0~255;Char是字符型。用单引号‘’或#加ASCII码的形式表示。进而学习到Pascal中,整型包括有符号整型和无符号整型,前者又包括Shortint(1)、SmallInt(2)、Integer(4)、Int64(8);后者包括Byte(1)、Word(2)、Longword(4),括号中表示所占的字节数。 2、AScII码:以前写程序从没有注意到过AscII码,但是在Delphi中要用到,ASCII:TheAmericanStandardCodeforInformationInterchange,美国(国家)信息交换标准(代)码,一种使用7个或8个二进制位进行编码的方案,ASCII码划分为两个集合:128个字符的标准ASCII码和附加的128个字符的扩展ASCII。基本的ASCII字符集共有128个字符,其中有96个可打印字符,包括常用的字母、数字、标点符号等,另外还有32个控制字符。标准ASCII码使用7个二进位对字符进行编码,对应的ISO标准为ISO646标准。由于标准ASCII字符集字符数目有限,在实际应用中往往无法满足要求。为此,国际标准化组织又制定了ISO2022标准,它规定了在保持与ISO646兼容的前提下将ASCII字符集扩充为8位代码的统一方法。ISO陆续制定了一批适用于不同地区的扩充ASCII字符集,每种扩充ASCII字符集分别可以扩充128个字符,这些扩充字符的编码均为高位为1的8位代码(即十进制数128~255),称为扩展ASCII码。 说了这么多,说来说去就是说,AScII码不过是用0~127或0~255表示的字符编码。在Iocomp的图形控件的事件字符中要使用AscII码,其实是表示一个字符,只不过是用AscII码的形式表示,所以前面要加上#,比如说,事件字符设为0X0a,这是十六进制,转化为十进制为10,所以表示为#10,事件字符如果是0x55,就可以表示为#85。 在Pascal中有两个系统函数完成AscII码的转换:Chr(X:Byte):Char--将AScII码转化为字符型,比如:chr(97)就表示a字符即'a';如果是十六进制的话,比如说0x0a,chr($0a),$在Delphi中表示十六进制。同样字符型转化为AScII码可以用ord(x),适用于所有的顺序类型。比如:ord('a')就转化为97. 3、学习Delphi不得不说String?字符串类型:String号称是Delphi中最灵活的数据类型,可是开始的时候,我感觉String是最讨厌的,为什么很多数据都用String表示嘛,串口接收到的数据明明是十六进制数据,用String表示多不方便呀,现在虽然能够理解,还未得String的精髓。而且字符串型还有其他两种怪怪的类型:AnsiString、WideString,还有一个UniCode,他们的区别很多资料上都有讲,可惜还没使用过,有些东西只有应用了才能参悟。 先断断续续写到这儿吧,以后有啥心得再补充。 凉凉我的作业: 1(原文件名:1.JPG) 2(原文件名:2.JPG) 3(原文件名:3.JPG) 源代码: MyComV0.1ourdev_438822.rar(文件大小:509K)(原文件名:DataPack.rar) 2009-04-22,20:31:13 资料 邮件 回复 引用回复 ↑↑↓↓ 编辑 删除        
本文档为【VB串口通信程序代码】,请使用软件OFFICE或WPS软件打开。作品中的文字与图均可以修改和编辑, 图片更改请在作品中右键图片并更换,文字修改请直接点击文字进行修改,也可以新增和删除文档中的内容。
该文档来自用户分享,如有侵权行为请发邮件ishare@vip.sina.com联系网站客服,我们会及时删除。
[版权声明] 本站所有资料为用户分享产生,若发现您的权利被侵害,请联系客服邮件isharekefu@iask.cn,我们尽快处理。
本作品所展示的图片、画像、字体、音乐的版权可能需版权方额外授权,请谨慎使用。
网站提供的党政主题相关内容(国旗、国徽、党徽..)目的在于配合国家政策宣传,仅限个人学习分享使用,禁止用于任何广告和商用目的。
下载需要: 免费 已有0 人下载
最新资料
资料动态
专题动态
is_697316
暂无简介~
格式:doc
大小:196KB
软件:Word
页数:69
分类:互联网
上传时间:2018-09-07
浏览量:37