📄 frmmain1.vb
字号:
'
'MnuPort
'
Me.MnuPort.Index = 0
Me.MnuPort.MenuItems.AddRange(New System.Windows.Forms.MenuItem() {Me.MnuCom1, Me.MnuCom2})
Me.MnuPort.Text = "端口选择"
'
'MnuCom1
'
Me.MnuCom1.Checked = True
Me.MnuCom1.Index = 0
Me.MnuCom1.Text = "MSCOMM1"
'
'MnuCom2
'
Me.MnuCom2.Index = 1
Me.MnuCom2.Text = "MSCOMM2"
'
'FrmMain1
'
Me.AutoScaleBaseSize = New System.Drawing.Size(6, 14)
Me.BackColor = System.Drawing.SystemColors.Control
Me.ClientSize = New System.Drawing.Size(728, 623)
Me.Controls.Add(Me.Text6)
Me.Controls.Add(Me.Command1)
Me.Controls.Add(Me.Frame7)
Me.Controls.Add(Me.Frame6)
Me.Controls.Add(Me.Frame4)
Me.Controls.Add(Me.Frame3)
Me.Controls.Add(Me.Frame2)
Me.Controls.Add(Me.Frame1)
Me.Controls.Add(Me.Frame5)
Me.Controls.Add(Me.MSComm1)
Me.Cursor = System.Windows.Forms.Cursors.Default
Me.Icon = CType(resources.GetObject("$this.Icon"), System.Drawing.Icon)
Me.Location = New System.Drawing.Point(11, 49)
Me.Menu = Me.MainMenu1
Me.Name = "FrmMain1"
Me.RightToLeft = System.Windows.Forms.RightToLeft.No
Me.Text = "Modbus RTU msb.sf@163.com"
Me.Frame7.ResumeLayout(False)
Me.Frame6.ResumeLayout(False)
Me.Frame4.ResumeLayout(False)
Me.Frame3.ResumeLayout(False)
Me.Frame2.ResumeLayout(False)
Me.Frame1.ResumeLayout(False)
Me.Frame5.ResumeLayout(False)
CType(Me.MSComm1, System.ComponentModel.ISupportInitialize).EndInit()
Me.ResumeLayout(False)
End Sub
#End Region
#Region "升级支持"
Private Shared m_vb6FormDefInstance As FrmMain1
Private Shared m_InitializingDefInstance As Boolean
Public Shared Property DefInstance() As FrmMain1
Get
If m_vb6FormDefInstance Is Nothing OrElse m_vb6FormDefInstance.IsDisposed Then
m_InitializingDefInstance = True
m_vb6FormDefInstance = New FrmMain1()
m_InitializingDefInstance = False
End If
DefInstance = m_vb6FormDefInstance
End Get
Set
m_vb6FormDefInstance = Value
End Set
End Property
#End Region
'***********************************************************************************************
'读多个保持寄存器值 功能码＝03H
'[地址][功能码][寄存器起始地址高8位][寄存器起始地址低8位][寄存器数量高8位][寄存器数量低8位][CRC低字节][CRC高字节]
'写多个保持寄存器值 功能码＝10H
'[地址][功能码][寄存器起始地址高8位][寄存器起始地址低8位][寄存器数量高8位][寄存器数量低8位][字节计数][数据高字节][数据低字节]...[数据高字节][数据低字节][CRC低字节][CRC高字节]
'写单个保持寄存器值 功能码＝06H
'[地址][功能码][寄存器起始地址高8位][寄存器起始地址低8位][数据高字节][数据低字节][CRC低字节][CRC高字节]
'
'编程 刘胜红 2007-07-13
'************************************************************************************************
'
Private Sub CmdPort_Click(ByVal eventSender As System.Object, ByVal eventArgs As System.EventArgs) Handles CmdPort.Click
If MSComm1.PortOpen = False Then
MSComm1.CommPort = Me.ComboPort.SelectedIndex + 1
MSComm1.Settings = "19200,e,8,1"
MSComm1.InputMode = MSCommLib.InputModeConstants.comInputModeBinary
MSComm1.PortOpen = True
End If
Timer1.Enabled = True
Timer2.Enabled = True
Timer3.Enabled = True
Me.CmdReadB.Enabled = True
Me.CmdReadVD.Enabled = True
Me.CmdReadVW.Enabled = True
Me.CmdWriteB0.Enabled = True
Me.CmdWriteB1.Enabled = True
Me.CmdWriteVD.Enabled = True
Me.CmdWriteVW.Enabled = True
If Err.Number Then '打开串口失败，则显示出错信息
MsgBox(ErrorToString(), 48, "错误信息")
Exit Sub
End If
End Sub
Private Sub CmdReadB_Click(ByVal eventSender As System.Object, ByVal eventArgs As System.EventArgs) Handles CmdReadB.Click
AddPLC = CStr(Me.CombAddPLC.Text)
AddrReadB = Me.TextAddRB.Text
BitNumber = Val(Me.TextBitNumR.Text)
ReadNumberB = Val(Me.CobRBNumber.Text)
Call GetBit(0, AddrReadB, BitNumber, ReadNumberB) '''''''0（FlagRec）表示还没有返回，此处一定为0，AddrRead为起始字节, BitNumber为位, ReadNumberB读的字数
'''''''如GetBit（0,3000,1,3）即读回 V3000.1,V3002.1,V3004.1,分别储存在ResultBit(0)、ResultBit(1)和ResultBit(2)
End Sub
Private Sub CmdReadVD_Click(ByVal eventSender As System.Object, ByVal eventArgs As System.EventArgs) Handles CmdReadVD.Click
AddPLC = CStr(Me.CombAddPLC.Text)
ReadNumberD = Val(Me.CobRDNumber.Text)
AddrReadD = CStr(TextAddRD.Text)
Call ReadVD(0, AddrReadD, ReadNumberD) ''''''0（FlagRec）表示还没有返回，此处一定为0，AddrRead为起始地址, 必须为偶数（MODBUS地址与PLC地址表示方法不同）ReadNumberD为读的双字数
'''''''如ReadVD（0,3000,2）即读回VD3000,VD3004,分别储存在DataVD(0)和DataVD(1)
End Sub
Private Sub CmdReadVW_Click(ByVal eventSender As System.Object, ByVal eventArgs As System.EventArgs) Handles CmdReadVW.Click
AddPLC = CStr(Me.CombAddPLC.Text)
ReadNumberW = Val(Me.CobRWNumber.Text)
AddrReadW = CStr(TextAddRW.Text)
Call ReadVW(0, AddrReadW, ReadNumberW) ''''''0（FlagRec）表示还没有返回，此处一定为0，AddrRead为起始地址, 必须为偶数，ReadNumberW为读的字数
'''''''如ReadVW（0,3000,2）即读回VW3000,VW3002,分别储存在DataVW(0)和DataVW(1)
End Sub
Private Sub CmdWriteB0_Click(ByVal eventSender As System.Object, ByVal eventArgs As System.EventArgs) Handles CmdWriteB0.Click
Dim AddrWrite As String
Dim BitNumber As Short
AddrWrite = Me.TextAddWB.Text
BitNumber = Val(Me.TextBitNumR.Text)
Call SetBitFalse(AddrWrite, BitNumber) ''''''AddrWrite为要写的地址, 必须为偶数，BitNumber为写的位数
'''''''SetBitFalse（3000,2） 即令V3000.2=0(为了处理方便，是令VW3000=0)
End Sub
Private Sub CmdWriteB1_Click(ByVal eventSender As System.Object, ByVal eventArgs As System.EventArgs) Handles CmdWriteB1.Click
Dim AddrWrite As String
Dim BitNumber As Short
AddrWrite = Me.TextAddWB.Text
BitNumber = Val(Me.TextBitNumR.Text)
Call SetBitTrue(AddrWrite, BitNumber) ''''''AddrWrite为要写的地址, 必须为偶数，BitNumber为写的位数
'''''''SetBitTrue（3000,3） 即令V3000.3=1(为了处理方便，是令VW3000=16#FFFF)
End Sub
Private Sub CmdWriteVD_Click(ByVal eventSender As System.Object, ByVal eventArgs As System.EventArgs) Handles CmdWriteVD.Click
Dim AddrWrite As String
Dim DataWrite As Single
AddPLC = CStr(Me.CombAddPLC.Text)
AddrWrite = CStr(TextAddWD.Text)
DataWrite = Val(Me.TextDataD.Text)
Call WriteVD(AddrWrite, DataWrite) ''''''AddrWrite为要写的地址, 必须为偶数，DataWrite为要写浮点数（一次写一个）
'''''''WriteVD（3000,25.5） 即令VD3000=25.5
End Sub
Private Sub CmdWriteVW_Click(ByVal eventSender As System.Object, ByVal eventArgs As System.EventArgs) Handles CmdWriteVW.Click
Dim AddrWrite As String
Dim DataWrite As Short
AddPLC = CStr(Me.CombAddPLC.Text)
AddrWrite = CStr(TextAddWW.Text)
DataWrite = Val(Me.TextDataW.Text)
Call WriteVW(AddrWrite, DataWrite) ''''''AddrWrite为要写的地址, 必须为偶数，DataWrite为要写的字的值（一次写一个字）
'''''''WriteVW（3000,111） 即令VW3000=111
End Sub
'UPGRADE_WARNING: 初始化窗体时可能激发事件 CombAddPLC.TextChanged。 单击以获得更多信息:“ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup2075"”
'UPGRADE_WARNING: ComboBox 事件 CombAddPLC.Change 被升级为具有新行为的 CombAddPLC.TextChanged。 单击以获得更多信息:“ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup2074"”
Private Sub CombAddPLC_TextChanged(ByVal eventSender As System.Object, ByVal eventArgs As System.EventArgs) Handles CombAddPLC.TextChanged
AddPLC = CStr(Me.CombAddPLC.SelectedIndex)
End Sub
Private Sub Command1_Click(ByVal eventSender As System.Object, ByVal eventArgs As System.EventArgs) Handles Command1.Click
Dim Form1 As Object
'UPGRADE_WARNING: 未能解析对象 Form1.Show 的默认属性。 单击以获得更多信息:“ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"”
Form1.Show()
End Sub
Private Sub Command2_Click()
End Sub
Private Sub FrmMain1_Load(ByVal eventSender As System.Object, ByVal eventArgs As System.EventArgs) Handles MyBase.Load
Dim i As Short
Me.SetBounds(VB6.TwipsToPixelsX((VB6.PixelsToTwipsX(System.Windows.Forms.Screen.PrimaryScreen.Bounds.Width) - VB6.PixelsToTwipsX(Me.Width)) \ 2), VB6.TwipsToPixelsY((VB6.PixelsToTwipsY(System.Windows.Forms.Screen.PrimaryScreen.Bounds.Height) - VB6.PixelsToTwipsY(Me.Height)) \ 2), 0, 0, Windows.Forms.BoundsSpecified.X Or Windows.Forms.BoundsSpecified.Y)
AddPLC = CStr(2)
ComboPort.Items.Add("1")
ComboPort.Items.Add("2")
ComboPort.Items.Add("3")
ComboPort.SelectedIndex = 1
For i = 0 To 254
CobRWNumber.Items.Add(CStr(i))
CobRDNumber.Items.Add(CStr(i))
CobRBNumber.Items.Add(CStr(i))
CobWWNumber.Items.Add(CStr(i))
CobWDNumber.Items.Add(CStr(i))
CobWBNumber.Items.Add(CStr(i))
Me.CombAddPLC.Items.Add(CStr(i))
Next
Me.CombAddPLC.SelectedIndex = 2
CobRWNumber.SelectedIndex = 3
CobRDNumber.SelectedIndex = 3
CobRBNumber.SelectedIndex = 3
CobWWNumber.SelectedIndex = 1
CobWDNumber.SelectedIndex = 1
CobWBNumber.SelectedIndex = 1
FlagVW = False
FlagVD = False
End Sub
'UPGRADE_WARNING: Form 事件 FrmMain1.Unload 具有新的行为。 单击以获得更多信息:“ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup2065"”
Private Sub FrmMain1_Closed(ByVal eventSender As System.Object, ByVal eventArgs As System.EventArgs) Handles MyBase.Closed
If MSComm1.PortOpen = True Then MSComm1.PortOpen = False
End Sub
Private Sub MSComm1_OnComm(ByVal eventSender As System.Object, ByVal eventArgs As System.EventArgs) Handles MSComm1.OnComm
Dim Inbyte() As Byte
Dim InHEx As String
Dim i As Object
Dim j As Short
Dim recstr As String
Dim a As Short
recstr = ""
ReDim inSafeArray(MSComm1.RThreshold)
If MSComm1.CommEvent = MSCommLib.OnCommConstants.comEvReceive Then '收到 RThreshold # of chars.
'UPGRADE_WARNING: 未能解析对象 MSComm1.Input 的默认属性。 单击以获得更多信息:“ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"”
Inbyte = MSComm1.Input
For i = 0 To MSComm1.RThreshold - 1
'UPGRADE_WARNING: 未能解析对象 i 的默认属性。 单击以获得更多信息:“ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"”
InHEx = Hex(Val(CStr(Inbyte(i))))
'UPGRADE_WARNING: 未能解析对象 i 的默认属性。 单击以获得更多信息:“ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"”
inSafeArray(i) = IIf(Len(InHEx) < 2, "0" & InHEx, InHEx)
'UPGRADE_WARNING: 未能解析对象 i 的默认属性。 单击以获得更多信息:“ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"”
recstr = recstr & inSafeArray(i)
Me.Text6.Text = recstr
Next i
a = Len(recstr)
FlagRec = 1
If FlagVW = True Then
If a = 2 * (5 + ReadNumberW * 2) Then '''加了保护
Call ReadVW(1, CStr(0), 0) '''判断如果接收字符长度对则进行分解''''第一个参数一定为1（Fl⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -