VERSION 5.00 Object = "{648A5603-2C6E-101B-82B6-000000000014}#1.1#0"; "MSCOMM32.OCX" Begin VB.Form Form1 Caption = "MMRS485" ClientHeight = 7320 ClientLeft = 60 ClientTop = 450 ClientWidth = 8340 LinkTopic = "Form1" ScaleHeight = 7320 ScaleWidth = 8340 StartUpPosition = 3 'Windows の既定値 Begin VB.Timer Timer1 Enabled = 0 'False Interval = 1000 Left = 6840 Top = 1200 End Begin VB.TextBox Text5 Height = 270 Left = 4920 TabIndex = 35 Text = "Text5" Top = 600 Width = 2415 End Begin VB.Frame Frame1 Caption = "マスタ" Height = 2415 Left = 600 TabIndex = 1 Top = 2040 Width = 3375 Begin VB.TextBox Text17 Height = 270 Left = 120 TabIndex = 39 Text = "電力計" Top = 1680 Width = 615 End Begin VB.TextBox Text20 Height = 270 Left = 120 TabIndex = 38 Text = "湿度計" Top = 1200 Width = 615 End Begin VB.TextBox Text19 BackColor = &H000000FF& Height = 270 Left = 120 TabIndex = 37 Text = "温度計" Top = 600 Width = 615 End Begin VB.TextBox Text1 Height = 270 Left = 480 TabIndex = 36 Text = "Text1" Top = 240 Width = 375 End Begin VB.PictureBox Picture4 Height = 1695 Left = 840 ScaleHeight = 1635 ScaleWidth = 2355 TabIndex = 26 Top = 600 Width = 2415 End Begin VB.TextBox Text11 Height = 270 Left = 960 TabIndex = 16 Text = "応答メッセージ" Top = 240 Width = 2295 End Begin VB.Label Label9 Height = 255 Left = 240 TabIndex = 40 Top = 960 Width = 495 End Begin VB.Label Label1 Caption = "ID" Height = 255 Left = 120 TabIndex = 33 Top = 240 Width = 255 End End Begin VB.ComboBox Combo1 Height = 300 Left = 1440 TabIndex = 32 Text = "ADDRESS" Top = 1560 Width = 1335 End Begin VB.CommandButton Command3 Caption = "RESET" Height = 375 Left = 3960 TabIndex = 31 Top = 1080 Width = 855 End Begin VB.CommandButton Command4 Caption = "LOG開始" Height = 375 Left = 2880 TabIndex = 30 Top = 1080 Width = 855 End Begin VB.CommandButton Command2 Caption = "計測停止" Height = 375 Left = 1800 TabIndex = 29 Top = 1080 Width = 855 End Begin VB.CommandButton Command1 Caption = "計測開始" Height = 375 Left = 720 TabIndex = 28 Top = 1080 Width = 855 End Begin VB.TextBox Text18 Height = 270 Left = 2880 TabIndex = 27 Text = "Text18" Top = 600 Width = 1935 End Begin VB.TextBox Text10 Height = 270 Left = 2160 TabIndex = 15 Text = "9" Top = 600 Width = 495 End Begin MSCommLib.MSComm MSComm1 Left = 7080 Top = 6360 _ExtentX = 1005 _ExtentY = 1005 _Version = 393216 DTREnable = -1 'True RThreshold = 1 BaudRate = 115200 InputMode = 1 End Begin VB.Frame Frame4 Caption = "スレーブ#3" Height = 2655 Left = 4200 TabIndex = 4 Top = 4560 Width = 3735 Begin VB.TextBox Text16 Height = 270 Left = 120 TabIndex = 25 Text = "湿度計" Top = 1080 Width = 735 End Begin VB.TextBox Text15 Height = 270 Left = 120 TabIndex = 24 Text = "温度計" Top = 720 Width = 735 End Begin VB.PictureBox Picture3 Height = 1695 Left = 960 ScaleHeight = 1635 ScaleWidth = 2475 TabIndex = 21 Top = 720 Width = 2535 End Begin VB.TextBox Text9 Height = 270 Left = 1080 TabIndex = 13 Text = "応答メッセージ" Top = 360 Width = 2415 End Begin VB.TextBox Text4 Height = 270 Left = 480 TabIndex = 10 Text = "ID3" Top = 360 Width = 495 End Begin VB.Label Label5 Caption = "ID" Height = 255 Left = 120 TabIndex = 9 Top = 360 Width = 255 End End Begin VB.Frame Frame3 Caption = "スレーブ#2" Height = 2655 Left = 600 TabIndex = 3 Top = 4560 Width = 3375 Begin VB.TextBox Text14 Height = 270 Left = 120 TabIndex = 23 Text = "湿度計" Top = 1080 Width = 615 End Begin VB.TextBox Text6 Height = 270 Left = 120 TabIndex = 22 Text = "温度計" Top = 720 Width = 615 End Begin VB.PictureBox Picture2 Height = 1815 Left = 840 ScaleHeight = 1755 ScaleWidth = 2355 TabIndex = 20 Top = 720 Width = 2415 End Begin VB.TextBox Text8 Height = 270 Left = 1080 TabIndex = 12 Text = "応答メッセージ" Top = 360 Width = 2175 End Begin VB.TextBox Text3 Height = 270 Left = 480 TabIndex = 8 Text = "ID2" Top = 360 Width = 495 End Begin VB.Label Label4 Caption = "ID" Height = 255 Left = 120 TabIndex = 7 Top = 360 Width = 255 End End Begin VB.Frame Frame2 Caption = "スレーブ#1" Height = 2415 Left = 4200 TabIndex = 2 Top = 2040 Width = 3735 Begin VB.TextBox Text13 Height = 270 Left = 120 TabIndex = 19 Text = "湿度計" Top = 960 Width = 735 End Begin VB.TextBox Text12 Height = 270 Left = 120 TabIndex = 18 Text = "温度計" Top = 600 Width = 735 End Begin VB.PictureBox Picture1 Height = 1695 Left = 960 ScaleHeight = 1635 ScaleWidth = 2475 TabIndex = 17 Top = 600 Width = 2535 End Begin VB.TextBox Text7 Height = 270 Left = 1080 MultiLine = -1 'True TabIndex = 11 Text = "MMRS485 CLASS5.frx":0000 Top = 240 Width = 2535 End Begin VB.TextBox Text2 Height = 270 Left = 480 TabIndex = 6 Text = "ID1" Top = 240 Width = 495 End Begin VB.Label Label3 Caption = "ID" Height = 255 Left = 120 TabIndex = 5 Top = 240 Width = 255 End End Begin VB.Label Label8 Height = 255 Left = 3000 TabIndex = 41 Top = 1560 Width = 615 End Begin VB.Label Label6 Caption = "送信先" Height = 255 Left = 720 TabIndex = 34 Top = 1560 Width = 615 End Begin VB.Label Label7 Caption = "COMポート番号" Height = 255 Left = 600 TabIndex = 14 Top = 600 Width = 1455 End Begin VB.Label Label2 Caption = "マルチモニタRS485ネットワーク" BeginProperty Font Name = "MS Pゴシック" 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, CMND, ID As Integer Dim TT(80000000) As Integer Dim Tpre(3), XX(3) As Integer Dim N, Nwidth As Integer Dim MM(3), Logmode As Boolean Dim temp As Single Dim MSG$, T$
Private Sub Combo1_Click() ID = SA(Combo1.ListIndex) ' Text7.Text = Str(ID) End Sub Private Sub Command1_Click() '温度計測および送信開始 'コマンド &HC0 リセット ' &HC1 PING ' &HC2 READ ' &HC3 WRITE ' READ FORMAT ' FUNCTION ID ' Bit 0 : COUNTER ' Bit 1 : I2C ' Bit 2 : RS485 ' Bit 3 : SPI ' Bit 4 : UART ' Bit 5 : VDC ' Bit 6 : ADC ' Bit 7 : OPTION ' PERIOD ' Bit 3-0 : Measurement Period (unit:100ms) ' Bit 7 : 0 - Contineous, 1 - One time ' NUMBER OF RESULT ' Bit 5-0 : COUNT ' Bit 6,7 : 0 - 12 bit, 1 - 16 bit ' If checkID(ID) Then If ID = SA(0) Then CMND = &HC2 ' READ MSG$ = Chr$(64) + Chr$(20) + Chr$(1) ' ADC , 1 sec period, 1 result/ Text5.Text = Hex$(CMND) + " " + Hex$(ID) + " " + Hex$(Len(MSG$)) MSComm1.Output = Chr$(CMND) + Chr$(ID) + Chr$(Len(MSG$)) + MSG$ MM(0) = True Timer1.Enabled = True Else MSG = "マスタ以外の計測にはまだ対応していません。" MsgBox MSG End If Else Text11.Text = "送信先エラー" End If End Sub Private Sub Command2_Click() '温度計測および送信停止 If checkID(ID) Then If ID = SA(0) Then Timer1.Enabled = False Else MSG = "マスタ以外の計測にはまだ対応していません。" MsgBox MSG End If Else Text11.Text = "送信先エラー" End If End Sub Private Sub Command3_Click() 'RESET N = 0 Picture4.Cls Timer1.Enabled = False End Sub Private Sub Command4_Click() 'LOG開始および停止 If checkID(ID) Then If ID = SA(0) Then If Logmode = True Then Command4.Caption = "LOG開始" Command4.BackColor = &H8000000F Logmode = False Else Logmode = True Command4.Caption = "LOG停止" Command4.BackColor = &HFF End If Else MSG = "マスタ以外の計測にはまだ対応していません。" MsgBox MSG End If Else Text11.Text = "送信先エラー" Text5.Text = "BAD" End If End Sub
Private Sub Form_Load() MA = 10 ' マスタアドレス N = 0 SA(0) = MA SA(1) = 1 SA(2) = 2 SA(3) = 3 ID = 0 Combo1.AddItem "マスタ" Combo1.AddItem "スレーブ#1" Combo1.AddItem "スレーブ#2" Combo1.AddItem "スレーブ#3" Text1.Text = Str(MA) Text2.Text = Str(SA(1)) Text3.Text = Str(SA(2)) Text4.Text = Str(SA(3)) Text5.Text = "OK" Picture4.PSet (0, Picture4.Height) Nwidth = Picture4.Width / 10 Logmode = False On Error GoTo ErrorHandler ComPortNum = 9 Text10.Text = Str(ComPortNum) ' VScroll1.Value = 16 - ComPortNum MSComm1.CommPort = ComPortNum MSComm1.Settings = "19200,N,8,1" MSComm1.PortOpen = True stage = 1 ' MSComm1.Output = Chr$(&HC0) + Chr$(10) + Chr$(4) + Chr$(10) + Chr$(1) + Chr$(2) + Chr$(3) 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 'Text7.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 Text18.Text = Hex$(inbuf(0)) + " " + Hex$(inbuf(1)) + " " + Hex$(inbuf(2)) _ + " " + Hex$(inbuf(3)) + " " + Hex$(inbuf(4)) ' + Hex$(inbuf(5)) + Hex$(inbuf(6)) + Hex$(inbuf(7)) ' + Hex$(inbuf(8)) + Hex$(inbuf(9)) + Hex$(inbuf(10)) ID = inbuf(1) temp = inbuf(3) * 256 + inbuf(4) T$ = Format(temp / 1.1 / 100 - 1, "##.#") Label9.Caption = T$ TT(N) = temp Label8.Caption = Str(N) N = N + 1 If ID = SA(0) Then Picture4.Line -Step(10, -(temp - Tpre(0)) / 3), &HFF& Tpre(0) = temp XX(0) = XX(0) + 1 If XX(0) > Nwidth Then XX(0) = 0 Picture4.Cls Picture4.PSet (0, Picture1.Height - temp / 3) End If ElseIf ID = SA(1) Then Picture1.Line -Step(4, temp - Tpre(1)) Tpre(1) = temp XX(1) = XX(1) + 1 If XX(1) > Nwidth Then XX(1) = 0 Picture1.Cls Picture1.PSet (0, temp) End If ElseIf ID = SA(2) Then Text8.Text = inbuf ElseIf ID = SA(3) Then Text9.Text = inbuf End If Text5.Text = " " End If End If End Sub Private Function checkID(ID As Integer) As Boolean If ID = MA Then checkID = True ElseIf ID = SA(1) Then checkID = True ElseIf ID = SA(2) Then checkID = True ElseIf ID = SA(3) Then checkID = True Else checkID = False End If End Function Private Sub Option2_Click()
End Sub Private Sub Timer1_Timer() If MM(0) = True Then MSComm1.Output = Chr$(CMND) + Chr$(ID) + Chr$(Len(MSG$)) + MSG$ If Logmode Then Open "温度記録" + Date$ + ".txt" For Append As #1 Write #1, Time$, T$ Close #1 End If End If End Sub |