|
VERSION 5.00
Object = "{648A5603-2C6E-101B-82B6-000000000014}#1.1#0"; "MSCOMM32.OCX"
Begin VB.Form Form1
Caption = "MMRS485"
ClientHeight = 6885
ClientLeft = 60
ClientTop = 450
ClientWidth = 8115
LinkTopic = "Form1"
ScaleHeight = 6885
ScaleWidth = 8115
StartUpPosition = 3 'Windows の既定値
Begin VB.Timer Timer1
Interval = 100
Left = 7200
Top = 240
End
Begin VB.TextBox Text10
Height = 270
Left = 2160
TabIndex = 26
Text = "9"
Top = 600
Width = 495
End
Begin MSCommLib.MSComm MSComm1
Left = 6360
Top = 240
_ExtentX = 1005
_ExtentY = 1005
_Version = 393216
DTREnable = -1 'True
RThreshold = 1
BaudRate = 115200
InputMode = 1
End
Begin VB.Frame Frame4
Caption = "スレーブ＃３"
Height = 2655
Left = 4200
TabIndex = 4
Top = 3600
Width = 3735
Begin VB.TextBox Text9
Height = 1455
Left = 240
MultiLine = -1 'True
ScrollBars = 2 '垂直
TabIndex = 24
Text = "MMRS485 CLASS6 HEX.frx":0000
Top = 840
Width = 3255
End
Begin VB.TextBox Text4
Height = 270
Left = 480
TabIndex = 12
Top = 360
Width = 495
End
Begin VB.Label Label5
Caption = "ID"
Height = 255
Left = 120
TabIndex = 11
Top = 360
Width = 255
End
End
Begin VB.Frame Frame3
Caption = "スレーブ＃２"
Height = 2655
Left = 600
TabIndex = 3
Top = 3600
Width = 3375
Begin VB.TextBox Text8
Height = 1575
Left = 120
MultiLine = -1 'True
ScrollBars = 2 '垂直
TabIndex = 23
Text = "MMRS485 CLASS6 HEX.frx":000F
Top = 840
Width = 3015
End
Begin VB.TextBox Text3
Height = 270
Left = 480
TabIndex = 10
Top = 360
Width = 495
End
Begin VB.Label Label4
Caption = "ID"
Height = 255
Left = 120
TabIndex = 9
Top = 360
Width = 255
End
End
Begin VB.Frame Frame2
Caption = "スレーブ＃１"
Height = 2415
Left = 4200
TabIndex = 2
Top = 960
Width = 3735
Begin VB.TextBox Text7
Height = 1335
Left = 240
MultiLine = -1 'True
ScrollBars = 2 '垂直
TabIndex = 22
Text = "MMRS485 CLASS6 HEX.frx":001E
Top = 840
Width = 3255
End
Begin VB.TextBox Text2
Height = 270
Left = 480
TabIndex = 8
Top = 240
Width = 495
End
Begin VB.Label Label3
Caption = "ID"
Height = 255
Left = 120
TabIndex = 7
Top = 240
Width = 255
End
End
Begin VB.Frame Frame1
Caption = "マスタ"
Height = 2535
Left = 600
TabIndex = 1
Top = 840
Width = 3375
Begin VB.TextBox Text12
Height = 270
Left = 2520
TabIndex = 28
Text = "Text12"
Top = 720
Width = 495
End
Begin VB.TextBox Text11
Height = 270
Left = 1200
TabIndex = 27
Text = "応答メッセージ"
Top = 1080
Width = 1935
End
Begin VB.TextBox Text6
Height = 270
Left = 1200
TabIndex = 21
Text = "WRITE DATA"
Top = 2040
Width = 1935
End
Begin VB.TextBox Text5
Height = 270
Left = 1200
TabIndex = 20
Text = "READ DATA"
Top = 1560
Width = 1935
End
Begin VB.OptionButton Option4
Caption = "WRITE"
Height = 255
Left = 120
TabIndex = 19
Top = 1920
Width = 975
End
Begin VB.OptionButton Option3
Caption = "READ"
Height = 255
Left = 120
TabIndex = 18
Top = 1560
Width = 975
End
Begin VB.OptionButton Option2
Caption = "RESET"
Height = 375
Left = 120
TabIndex = 17
Top = 720
Width = 855
End
Begin VB.OptionButton Option1
Caption = "PING"
Height = 255
Left = 120
TabIndex = 16
Top = 1200
Width = 855
End
Begin VB.CommandButton Command1
Caption = "発行"
Height = 375
Left = 1200
TabIndex = 15
Top = 600
Width = 615
End
Begin VB.ComboBox Combo1
Height = 300
Left = 1920
TabIndex = 14
Text = "SLAVE ADDRESS"
Top = 240
Width = 1335
End
Begin VB.TextBox Text1
Height = 270
Left = 480
TabIndex = 6
Text = "Text1"
Top = 240
Width = 495
End
Begin VB.Label Label6
Caption = "送信先"
Height = 255
Left = 1200
TabIndex = 13
Top = 240
Width = 615
End
Begin VB.Label Label1
Caption = "ID"
Height = 255
Left = 120
TabIndex = 5
Top = 240
Width = 255
End
End
Begin VB.Label Label8
Height = 375
Left = 600
TabIndex = 29
Top = 6360
Width = 7335
End
Begin VB.Label Label7
Caption = "COMポート番号"
Height = 255
Left = 600
TabIndex = 25
Top = 600
Width = 1455
End
Begin VB.Label Label2
Caption = "マルチモニタRS485ネットワーク"
BeginProperty Font
Name = "ＭＳ Ｐゴシック"
Size = 15.75
Charset = 128
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 1440
TabIndex = 0
Top = 120
Width = 4215
End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim ComPortNum As Integer
Dim NameDD$(3, 4)
Dim SW(3), SA(4)
Dim inbuf() As Byte
Dim N_OnComm, MA, ID, TA, SLAD, stage As Integer
Dim Abend As Boolean
Private Sub Combo1_Click()
ID = SA(Combo1.ListIndex + 1)
' Text7.Text = Str(ID)
End Sub
Private Sub Command1_Click()
'発行
ID = Int(ID)
If checkID(ID) Then
If Option1.Value Then
CMND = &HC1 ' PING
msg$ = Chr$(ID) + Chr$(ID)
ElseIf Option2.Value Then
CMND = &HC0 ' RESET
msg$ = Chr$(ID) + Chr$(ID)
ElseIf Option3.Value Then
CMND = &HC2 ' READ
msg$ = "AB"
ElseIf Option4.Value Then
CMND = &HC3 ' WRITE
msg$ = Text6.Text
Else
Text11.Text = "コマンドエラー"
Exit Sub
End If
MSComm1.Output = Chr$(CMND) + Chr$(ID) + Chr$(Len(msg$)) + msg$
Else
Text11.Text = "送信先エラー"
End If
End Sub
Private Sub Form_Load()
SA(1) = 1
SA(2) = 0
SA(3) = 0
MA = 10
ID = 0
Combo1.AddItem "スレーブ＃１"
Combo1.AddItem "スレーブ＃２"
Combo1.AddItem "スレーブ＃３"
Text1.Text = Str(MA)
On Error GoTo ErrorHandler
ComPortNum = 7
Text10.Text = Str(ComPortNum)
' VScroll1.Value = 16 - ComPortNum
MSComm1.CommPort = ComPortNum
MSComm1.Settings = "19200,N,8,1"
MSComm1.PortOpen = True
STEP0:
' Show frmTip
' frmTip.Label1.Caption = "スレーブデバイスを調べています。しばらくお待ちください。"
stage = 0
'MSComm1.Output = Chr$(&HC0) + Chr$(&HFE) + Chr$(4) + Chr$(10) + Chr$(1) + Chr$(2) + Chr$(3)
GoTo STEP1
J = 0
For i = 1 To 9
MSComm1.Output = Chr$(&HC1) + Chr$(i) + Chr$(2) + Chr$(10) + Chr$(1)
TA = 1
SLAD = 0
DoEvents
Abend = False
While TA <> 0
DoEvents
Wend
If SLAD > 0 Then
SA(J) = Int(SLAD)
J = J + 1
If J > 3 Then
msg = "スレーブデバイスが3個以上あります。3個以上は無視されます。"
MsgBox msg
End If
End If
DoEvents
Text2.Text = Str(SA(1))
Text3.Text = Str(SA(2))
Text4.Text = Str(SA(3))
Next
STEP1:
Text2.Text = Str(SA(1))
Text3.Text = Str(SA(2))
Text4.Text = Str(SA(3))
stage = 1
Exit Sub
ErrorHandler:
If Err.Number = 8002 Then
msg = "通信ポートが開かれていません。通信ポートを接続して下さい。"
MsgBox msg
ElseIf Err.Number = 0 Then
msg = "通信エラーです。"
MsgBox msg
Else
msg = "原因不明のエラーです。エラー番号" + Str(Err.Number)
MsgBox msg
End If
End Sub
Private Sub MSComm1_OnComm()
N_OnComm = N_OnComm + 1
Text12.Text = MSComm1.InBufferCount
If MSComm1.CommEvent > 1000 Then
LenInBuf = MSComm1.InBufferCount
inbuf = MSComm1.Input
MSComm1.InBufferCount = 0
' Text7.Text = inbuf(0) + Str(inbuf(1)) + Str(inbuf(2))
Exit Sub
End If
If MSComm1.CommEvent = comEvReceive Then
keyPressed = False
If MSComm1.InBufferCount >= 1 Then
LenInBuf = MSComm1.InBufferCount
' Label11.Caption = Str(LenInBuf)
inbuf = MSComm1.Input
aa$ = Hex$(inbuf(0)) + " " + Hex$(inbuf(1)) + " " + Hex$(inbuf(2))
For i = 0 To inbuf(2) - 1
aa$ = aa$ + " " + Hex$(inbuf(3 + i))
Next
Text11.Text = aa$
' + Hex$(inbuf(5)) + Hex$(inbuf(6)) + Hex$(inbuf(7))
' + Hex$(inbuf(8)) + Hex$(inbuf(9)) + Hex$(inbuf(10))
ID = inbuf(1)
If stage = 1 Then
If ID = MA Or ID = &HFE Then
Text11.Text = aa$
ElseIf ID = SA(1) Then
Text7.SelText = aa$ + vbCrLf
ElseIf ID = SA(2) Then
Text8.SelText = aa$ + vbCrLf
ElseIf ID = SA(3) Then
Text9.SelText = aa$ + vbCrLf
End If
Else
SLAD = ID
' TA = 0
End If
End If
End If
End Sub
Private Function checkID(ByVal ID As Integer) As Boolean
If ID = MA Then
checkID = True
ElseIf (SA(1) > 0) And (ID = SA(1)) Then
checkID = True
ElseIf (SA(2) > 0) And (ID = SA(2)) Then
checkID = True
ElseIf (SA(3) > 0) And (ID = SA(3)) Then
checkID = True
Else
checkID = False
End If
End Function
Private Sub Timer1_Timer()
TA = TA + 1
If TA > 5 Then
SLAD = 0
Abend = 1
TA = 0
End If
End Sub
|
