frmmain.frm

PCMM控件 与 ModbusRtu 协议结合 以控制工控设备的实例代码

VERSION 5.00
Object = "{43715ED3-EE9F-4827-A03F-1C1C99883974}#1.0#0"; "Moubus.ocx"
Begin VB.Form frmMain 
   BorderStyle     =   3  'Fixed Dialog
   Caption         =   "Modbus Client demo"
   ClientHeight    =   3675
   ClientLeft      =   735
   ClientTop       =   330
   ClientWidth     =   5910
   Icon            =   "frmMain.frx":0000
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   3675
   ScaleWidth      =   5910
   StartUpPosition =   1  '所有者中心
   Begin ModbusRtus.ModbusRtu ModbusRtu1 
      Left            =   90
      Top             =   2115
      _ExtentX        =   3784
      _ExtentY        =   2672
   End
   Begin VB.CommandButton cmdAbout 
      Caption         =   "关于"
      Height          =   375
      Left            =   3330
      TabIndex        =   19
      Top             =   3105
      Width           =   1005
   End
   Begin VB.CommandButton cmdClose 
      Caption         =   "关闭"
      Height          =   375
      Left            =   4455
      TabIndex        =   18
      Top             =   3105
      Width           =   1005
   End
   Begin VB.Frame Frame4 
      Caption         =   "PLC连接"
      Height          =   795
      Left            =   180
      TabIndex        =   14
      Top             =   90
      Width           =   5565
      Begin VB.PictureBox picFlag 
         BackColor       =   &H000000FF&
         Height          =   315
         Left            =   150
         ScaleHeight     =   255
         ScaleWidth      =   285
         TabIndex        =   17
         Top             =   300
         Width           =   345
      End
      Begin VB.ComboBox cmbNo 
         Height          =   300
         Left            =   600
         Style           =   2  'Dropdown List
         TabIndex        =   16
         Top             =   300
         Width           =   3825
      End
      Begin VB.CommandButton cmdLogin 
         Caption         =   "登录"
         Height          =   345
         Left            =   4560
         TabIndex        =   15
         Top             =   270
         Width           =   795
      End
   End
   Begin VB.Frame Frame2 
      Caption         =   "发送数据/修改数据"
      Height          =   1905
      Left            =   180
      TabIndex        =   0
      Top             =   1050
      Width           =   5565
      Begin VB.ComboBox cmbLen 
         Height          =   300
         ItemData        =   "frmMain.frx":038A
         Left            =   4710
         List            =   "frmMain.frx":0394
         Locked          =   -1  'True
         Style           =   2  'Dropdown List
         TabIndex        =   8
         Top             =   330
         Width           =   645
      End
      Begin VB.Timer tmrRead 
         Enabled         =   0   'False
         Interval        =   1000
         Left            =   5370
         Top             =   690
      End
      Begin VB.CheckBox chkRun 
         Alignment       =   1  'Right Justify
         Caption         =   "连续读"
         ForeColor       =   &H00FF8080&
         Height          =   345
         Left            =   3120
         TabIndex        =   7
         Top             =   720
         Width           =   885
      End
      Begin VB.CommandButton cmdWriteData 
         Caption         =   "写"
         Height          =   315
         Left            =   4800
         TabIndex        =   6
         Top             =   720
         Width           =   555
      End
      Begin VB.ComboBox cmbType 
         Height          =   300
         ItemData        =   "frmMain.frx":039E
         Left            =   3450
         List            =   "frmMain.frx":03AE
         Style           =   2  'Dropdown List
         TabIndex        =   5
         Top             =   330
         Width           =   645
      End
      Begin VB.TextBox txtData 
         Height          =   585
         Left            =   210
         MultiLine       =   -1  'True
         TabIndex        =   4
         Top             =   1110
         Width           =   5145
      End
      Begin VB.ComboBox cmbNum 
         Height          =   300
         Left            =   2130
         Style           =   2  'Dropdown List
         TabIndex        =   3
         Top             =   330
         Width           =   675
      End
      Begin VB.CommandButton cmdReadData 
         Caption         =   "读"
         Height          =   315
         Left            =   4230
         TabIndex        =   2
         Top             =   720
         Width           =   555
      End
      Begin VB.TextBox txtAddr 
         Height          =   285
         Left            =   1080
         TabIndex        =   1
         Text            =   "0"
         Top             =   330
         Width           =   465
      End
      Begin VB.Label lblLen 
         Caption         =   "类别："
         Height          =   285
         Index           =   0
         Left            =   4200
         TabIndex        =   13
         Top             =   390
         Width           =   1125
      End
      Begin VB.Label Label1 
         Caption         =   "数据："
         Height          =   285
         Index           =   3
         Left            =   210
         TabIndex        =   12
         Top             =   780
         Width           =   1065
      End
      Begin VB.Label Label1 
         Caption         =   "类型："
         Height          =   285
         Index           =   2
         Left            =   2940
         TabIndex        =   11
         Top             =   390
         Width           =   705
      End
      Begin VB.Label lblLen 
         Caption         =   "个数："
         Height          =   285
         Index           =   1
         Left            =   1620
         TabIndex        =   10
         Top             =   390
         Width           =   705
      End
      Begin VB.Label Label1 
         Caption         =   "变量地址："
         Height          =   285
         Index           =   0
         Left            =   210
         TabIndex        =   9
         Top             =   390
         Width           =   1065
      End
   End
End
Attribute VB_Name = "frmMain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'*************************************************************************
'**模 块 名：frmTest
'**说    明：YFsoft 版权所有2005 - 2006(C)
'**创 建 人：叶帆
'**日    期：2005-08-23 14:45:36
'**修 改 人：
'**日    期：
'**描    述：Modbus Client 控件示例(需连接西门子200PLC)
'**          非注册版本只能读取变量区的前10个地址,注册用户读写数据无限制，也无用户个数限制
'**          获取注册图片后，直接拷贝到控件的当前目录即可完成注册，注意在程序中添加下面一行代码：
'**          ModbusRtu1.RegCompany="×××公司"  公司名称要和你注册提交的公司名称一致
'**          最新版本请关注：http://blog.csdn.net/yefanqiu
'**在线注册：http://www.softreg.com.cn/shareware_view.asp?id=/268087AD-2589-4D03-831B-85ED1BDEDE84/
'**描    述：MbClient 控件示例
'**版    本：V1.0.0
'*************************************************************************

'*************************************************************************
'**函 数 名：chkRun_Click
'**输    入：无
'**输    出：无
'**功能描述：
'**全局变量：
'**调用模块：
'**作    者：叶帆
'**日    期：2005-08-28 11:11:25
'**修 改 人：
'**日    期：
'**版    本：V1.0.0
'*************************************************************************
Private Sub chkRun_Click()
   tmrRead.Enabled = IIf(chkRun.Value = 0, False, True)
End Sub

'*************************************************************************
'**函 数 名：cmbType_Click
'**输    入：无
'**输    出：无
'**功能描述：
'**全局变量：
'**调用模块：
'**作    者：叶帆
'**日    期：2005-08-29 11:42:33
'**修 改 人：
'**日    期：
'**版    本：V1.0.0
'*************************************************************************
Private Sub cmbType_Click()
  If cmbType.ListIndex < 2 Then
     cmbLen.ListIndex = 0
  Else
     cmbLen.ListIndex = 1
  End If
End Sub

'*************************************************************************
'**函 数 名：cmdAbout_Click
'**输    入：无
'**输    出：无
'**功能描述：
'**全局变量：
'**调用模块：
'**作    者：叶帆
'**日    期：2005-11-19 23:48:27
'**修 改 人：
'**日    期：
'**版    本：V1.0.0
'*************************************************************************
Private Sub cmdAbout_Click()
    ModbusRtu1.About
End Sub

'*************************************************************************
'**函 数 名：cmdClose_Click
'**输    入：无
'**输    出：无
'**功能描述：
'**全局变量：
'**调用模块：
'**作    者：叶帆
'**日    期：2005-11-19 23:48:12
'**修 改 人：
'**日    期：
'**版    本：V1.0.0
'*************************************************************************
Private Sub cmdClose_Click()
    Unload Me
End Sub

'*************************************************************************
'**函 数 名：cmdLogin_Click
'**输    入：无
'**输    出：无
'**功能描述：
'**全局变量：
'**调用模块：
'**作    者：叶帆
'**日    期：2005-07-26 20:39:33
'**修 改 人：
'**日    期：
'**版    本：V1.0.0
'*************************************************************************
Private Sub cmdLogin_Click()
    Dim lngData() As Long
    Dim lngRet As Long
    
    ModbusRtu1.FixAddr = cmbNo.ListIndex + 1
    lngRet = ModbusRtu1.ReadData(Val(txtAddr), lngData(), , , Modbus_V)
    If lngRet = 0 Then
        picFlag.BackColor = RGB(0, 255, 0)
    Else
        picFlag.BackColor = RGB(255, 0, 0)
    End If
End Sub
'*************************************************************************
'**函 数 名：cmdSendData_Click
'**输    入：无
'**输    出：无
'**功能描述：
'**全局变量：
'**调用模块：
'**作    者：叶帆
'**日    期：2005-08-27 23:59:32
'**修 改 人：
'**日    期：
'**版    本：V1.0.0
'*************************************************************************
Private Sub cmdReadData_Click()
    On Error GoTo ToExit '打开错误陷阱
    '------------------------------------------------
   Dim i As Long
   Dim bytType As Byte
   Dim lngData() As Long

   Select Case cmbType.ListIndex
     Case 0: bytType = Modbus_I
     Case 1: bytType = Modbus_Q
     Case 2: bytType = Modbus_AI
     Case 3: bytType = Modbus_V
    End Select
   
   ModbusRtu1.FixAddr = cmbNo.ListIndex + 1
   If ModbusRtu1.ReadData(Val(txtAddr), lngData(), Val(cmbNum.Text), Val(cmbLen.ListIndex), Val(bytType)) = 0 Then
      txtData = ""
      For i = 1 To Val(cmbNum.Text)
        txtData = txtData & Format(lngData(i - 1), "0") & " "
      Next
   Else
     txtData = "Error"
   End If
    '------------------------------------------------
    Exit Sub
    '----------------
ToExit:
   MsgBox Err.Description
End Sub


'*************************************************************************
'**函 数 名：cmdWriteData_Click
'**输    入：无
'**输    出：无
'**功能描述：
'**全局变量：
'**调用模块：
'**作    者：叶帆
'**日    期：2005-08-28 11:43:08
'**修 改 人：
'**日    期：
'**版    本：V1.0.0
'*************************************************************************
Private Sub cmdWriteData_Click()
    On Error GoTo ToExit '打开错误陷阱
    '------------------------------------------------
    Dim bytType As Byte
    Dim strData() As String
    Dim lngData() As Long
    Dim i As Long

   Select Case cmbType.ListIndex
     Case 0: bytType = Modbus_I
     Case 1: bytType = Modbus_Q
     Case 2: bytType = Modbus_AI
     Case 3: bytType = Modbus_V
    End Select

    If Len(txtData) > 0 Then
        strData = Split(txtData, " ")
        ReDim lngData(UBound(strData))
        For i = 0 To UBound(strData)
          lngData(i) = Val(strData(i))
        Next
        If ModbusRtu1.WriteData(Val(txtAddr), lngData, UBound(strData) + 1, Val(cmbLen.ListIndex), Val(bytType), cmbNo.ListIndex + 1) = 0 Then
            '
        Else
            txtData = "Error"
        End If
    End If
    '------------------------------------------------
    Exit Sub
    '----------------
ToExit:
    MsgBox Err.Description
End Sub

'*************************************************************************
'**函 数 名：Form_Load
'**输    入：无
'**输    出：无
'**功能描述：
'**全局变量：
'**调用模块：
'**作    者：叶帆
'**日    期：2005-08-28 19:07:04
'**修 改 人：
'**日    期：
'**版    本：V1.0.0
'*************************************************************************
Private Sub Form_Load()
   Dim i As Long
   For i = 1 To 222
     cmbNo.AddItem Format(i, "0")
   Next
   For i = 1 To 100
     cmbNum.AddItem Format(i, "0")
   Next
   cmbNum.ListIndex = 0
   cmbNo.ListIndex = 0
   cmbType.ListIndex = 3
   
   ModbusRtu1.InitRegCompany "×××公司"    '已注册的公司名称
   ModbusRtu1.OpenPort 1
End Sub

'*************************************************************************
'**函 数 名：Form_Unload
'**输    入：Cancel(Integer) -
'**输    出：无
'**功能描述：关闭串口
'**全局变量：
'**调用模块：
'**作    者：叶帆
'**日    期：2005-08-23 14:40:05
'**修 改 人：
'**日    期：
'**版    本：V1.0.0
'*************************************************************************
Private Sub Form_Unload(Cancel As Integer)
   ModbusRtu1.ClosePort
   End
End Sub


'*************************************************************************
'**函 数 名：tmrRead_Timer
'**输    入：无
'**输    出：无
'**功能描述：
'**全局变量：
'**调用模块：
'**作    者：叶帆
'**日    期：2005-08-28 11:10:58
'**修 改 人：
'**日    期：
'**版    本：V1.0.0
'*************************************************************************
Private Sub tmrRead_Timer()
   cmdReadData_Click
End Sub