Skip to content

Instantly share code, notes, and snippets.

@dj1711572002

dj1711572002/Serial_Graphic_Monitor_rev03.vb

Created September 12, 2020 21:06
Show Gist options
  • Star 0 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
  • Save dj1711572002/5956d6f0b78e21cb66b33fa8be66a23a to your computer and use it in GitHub Desktop.
Save dj1711572002/5956d6f0b78e21cb66b33fa8be66a23a to your computer and use it in GitHub Desktop.
Download ZIP
MultiPort_Receiving_testProgram_VB.NET
Raw
Serial_Graphic_Monitor_rev03.vb
'Seril Port Recieve Sample Program
'Form1 Object must create ,button1,2 & textbox 1,2　
Imports System.Drawing
Imports System.IO.Ports
Public Class Form1
Dim ReceivedData1 As String = " " '受信データ用変数を宣言します
Dim ReceivedData2 As String = " " '受信データ用変数を宣言します
Dim ReceivedData3 As String = " "
Private com1_None As Integer
Private com2_None As Integer
'==========LinearMode Parameteres==============
Public cp1X As Integer(,)
Public cp1Y As Integer(,)
Public cp2X As Integer(,)
Public cp2Y As Integer(,)
Public cp3X As Integer(,)
Public cp3Y As Integer(,)
'=========Receive Stop===========
Public rFlag As Integer = 1
Public rcFlag As Integer = 0
'=======file===============
Public fname As String = ""
Public file As System.IO.StreamWriter
'======PictureBoxSize========
Const yh = 240
Const xw = 600
Private onetime As Integer = 1
Delegate Sub DataDelegate(ByVal sdata As String)
'=========Available Parameters in thie Calss=================
Private dataAry(600000, 7) As Long
Private dataNo As Long
'---------Plotting parameters--------------
Private rate() As Double
Private Mag As Double
Private midvalue() As Double
Private dstep As Double 'x軸ドット単位　dot/dataNo
Private dvalue As Double = 1 'Ｙ軸ドット単位　dot/mV 10mvで１ドット
'-----------------------------------------
Private Mave() As Double
Private sw As New System.Diagnostics.Stopwatch()
Private tp As TimeSpan
Private timestamp As Integer
Private stime As Integer 'plot start sampling time
Private etime As Integer 'plot end sampling time
Private totalsec As Double
Private startFlag As Integer = 0
Private px As Integer
Private py As Integer
Private px_1 As Integer
Private py_1 As Integer '１個前のＹ座標
'=============================================================
Private Sub PrintData(ByVal sdata As String)
'========First CSV File Declaration======================
If CheckBox8.Checked = True And fname = "" Then
fname = Format(Now, "yyyyMMdd_HHmmss")
fname = "C:\vb_LOG\" & fname & ".csv"
TextBox21.Text = fname
'---MS Example------------------------------
'Dim file As System.IO.StreamWriter
'file = My.Computer.FileSystem.OpenTextFileWriter("c:\test.txt", True)
'file.WriteLine("Here is the first string.")
'file.Close()
'------------------------------------------
Dim enc As System.Text.Encoding = System.Text.Encoding.GetEncoding(“Shift_JIS”)
file = My.Computer.FileSystem.OpenTextFileWriter(fname, False, enc)
End If
' Debug.Print("sdata=" & sdata)
'=========================================================
Dim delimiter As String = ","
Dim i As Integer
Dim dcount As String
'================sdata File writing====================
If System.IO.File.Exists(fname) Then
file.Write(sdata)
Label7.Text = "Logging"
End If
'=======================LIST BOX=======================================
If CheckBox11.Checked = True Then
ListBox1.Items.Add(sdata)
End If
'======================================================================
Dim dStr() As String = Split(sdata, delimiter, -1, CompareMethod.Text)
Dim colN As Integer
colN = 7
'Debug.Print("dStr.length=" & CStr(dStr.Length) & "sdata.Length=" & CStr(sdata.Length))
If dStr.Length = 7 And sdata.Length < 37 Then
dataNo += 1
'dStr(0) = dataNo
For i = 0 To dStr.Length - 1
dataAry(dataNo, i) = CInt(dStr(i))
Next
If startFlag = 1 Then
'=================PLOT SUBへ=================
'If i < 6 Then
plotC(dataNo, dataAry(dataNo, i), dataAry(dataNo - 1, i), i) 'plotC(x,y,colorN)
'Debug.Print("dataAry()=" & CStr(dataAry(dataNo, i)) & "i=" & CStr(i))
'End If
'===========================================
End If
TextBox2.Text = dataNo
TextBox3.Text = dStr.Length
TextBox4.Text = dStr(0)
TextBox5.Text = dStr(1)
TextBox6.Text = dStr(2)
TextBox7.Text = dStr(3)
TextBox8.Text = dStr(4)
TextBox9.Text = dStr(5)
TextBox10.Text = dStr(6)
'Debug.Print("dataAry(" & CStr(dataNo) & "," & CStr(i) & ")=" & CStr(dataAry(dataNo, i)))
End If
End Sub
'===================================================================================================================
'*************************SerialPort Open Close REceive***************************************************************
'===================================================================================================================
Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
SerialPort1.PortName = ComboBox10.SelectedItem 'TextBox1.Text 'オープンするポート名を格納
SerialPort2.PortName = ComboBox11.SelectedItem
If SerialPort1.PortName <> "None" Then
SerialPort1.Open() 'ポートオープン
Label2.Text = "Port1_OPENED"
com1_None = 0
End If
If SerialPort1.PortName = "None" Then
com1_None = 1
End If
If SerialPort2.PortName <> "None" Then
SerialPort2.Open() 'ポートオープン
Label22.Text = "Port2_OPENED"
com2_None = 0
End If
If SerialPort2.PortName = "None" Then
com2_None = 1
End If
'Received CheckBox ON
CheckBox9.Checked = True
End Sub
Private Sub Button2_Click(sender As Object, e As EventArgs) Handles Button2.Click
Dim k As Integer
If System.IO.File.Exists(fname) Then
file.Close()
Label7.Text = "FileClosed"
fname = ""
TextBox21.Text = fname
End If
If SerialPort1.IsOpen = True Then 'ポートオープン済み
SerialPort1.Close() 'ポートクローズ
Label2.Text = "Port1_CLOSED"
End If
If SerialPort2.IsOpen = True Then 'ポートオープン済み
SerialPort2.Close() 'ポートクローズ
Label22.Text = "Port2_CLOSED"
End If
End Sub
Private Sub PrintData1(ByVal sdata As String)
ListBox1.Items.Add(sdata)
End Sub
'***************************************************************************************************************************
'******************************DataReceiving********************************************************************************
'***************************************************************************************************************************
Private Sub SerialPort1_DataReceived(sender As Object, e As SerialDataReceivedEventArgs) Handles SerialPort1.DataReceived
If CheckBox9.Checked = True And com1_None = 0 Then
Try
ReceivedData1 = SerialPort1.ReadLine 'データを受信します
ReceivedData2 = SerialPort2.ReadLine
ReceivedData3 = ReceivedData1 & ReceivedData2
Catch ex As Exception
ReceivedData3 = ex.Message '例外処理を行います
End Try
'Invokeメソッドにより実行されるメソッドへのデリゲートの宣言を行い、受信データを表示します
Dim adre As New DataDelegate(AddressOf PrintData)
Me.Invoke(adre, ReceivedData3)
End If
End Sub
'Private Sub SerialPort2_DataReceived(sender As Object, e As SerialDataReceivedEventArgs) Handles SerialPort1.DataReceived
' If CheckBox9.Checked = True And com2_None = 0 Then
' Try
' ReceivedData2 = SerialPort2.ReadLine 'データを受信します
' Catch ex As Exception
' ReceivedData2 = ex.Message '例外処理を行います
' End Try
' 'Invokeメソッドにより実行されるメソッドへのデリゲートの宣言を行い、受信データを表示します
' Dim adre As New DataDelegate(AddressOf PrintData)
' Me.Invoke(adre, ReceivedData2)
' End If
'End Sub
'*****************************************************************************************************************************
'*****************************************************************************************************************************
'*****************************************************************************************************************************
'=================================================================================================================
'===================================SerialPort Setting End==================================================================
'=================================================================================================================
'===============Plotting Start Button=======================
Private Sub Button3_Click(sender As Object, e As EventArgs) Handles Button3.Click
If startFlag = 0 Then
startFlag = 1
Label20.Text = "--Plotting--"
End If
End Sub
'===============Plotting Stop===================================
Private Sub Button4_Click(sender As Object, e As EventArgs) Handles Button4.Click
If startFlag = 1 Then
startFlag = 0
Label20.Text = "--PlotStopped--"
End If
End Sub
'**************************************************************************************************************************************************
'================================描画メソッドPlotc()===================================================
'===========-PLOT パラメータの定義　計算方式===================================================
'===========ゼロレベルでデフォルト平均値(1650ｍＶ)をとってCenteringを実施してY軸中心にそろえる===============
'===========負荷をいれながらrate値（ドット/mV）を手動で変えて最適値にセット========================
'==========================================================================================
Sub plotC(ByVal dataNo As Integer, ByVal value As Integer, ByVal value_1 As Integer, ByVal colorN As Integer)
If PictureBox1.Image Is Nothing Then '初回だけＢＩＴＭＡＰを定義する　Picture1.imageという名称をつかうこと
PictureBox1.Image = New Bitmap(720, 240)
End If
Dim g As Graphics = Graphics.FromImage(PictureBox1.Image)
Dim Ch_sel(7) As Integer
Ch_sel = CheckBR() 'CheckBox Checked array 1=ON 0=OFF
'==============Text Box Value Reading===================================
Dim rate(7) As Double
Dim midvalue(7) As Double
rate = RateCR() ' rate(0-6)はdot/mV
midvalue = AvTR() 'midvalue(0-6)はゼロレベル値
'==============TrackBar value Read==============
Dim TBvalue As Integer
Dim TBposition As Integer
TBvalue = TrackBar1.Value
TBposition = CInt(TBvalue / 100 * yh)
TextBox20.Text = CStr(TBvalue)
'*************************************************************************************
'**************************************************************************************
'=========================================================================
'=================Plot Oresen Graph=========================================
'=========================================================================
'------------Pen COLORS------------
Dim p1, p2, p3, p4, p5, p6 As New Pen(Color.Black)
Dim b As Brush
b = Brushes.Black
p1.Width = 0.1
p2.Width = 0.1
p3.Width = 0.1
p4.Width = 0.1
p5.Width = 0.1
p6.Width = 0.1
p1 = Pens.Red
p2 = Pens.Blue
p3 = Pens.Green
p4 = Pens.Magenta
p5 = Pens.Orange
p6 = Pens.Black
'=============PLOT パラメータ準備==============
Dim xscale As Integer = 2
'--Y軸
'-------------ドット変換値設定-------
dstep = 1 'X軸基本
Mag = CDbl(ComboBox8.SelectedItem) 'Ｘ軸倍率 0.01-0.5 1-10 dot/dataNo
'===========================Drawing=================================================================
If CheckBox10.Checked = False Then '*********False=Oresen View Mode /True=LenearViewMode
'===================スクロール　クリア＆時間測定========================================
' Debug.Print("dataNo=" & CStr(dataNo) & "cstr(600/Mag)=" & CStr(600 / Mag))
If dataNo Mod CInt(600 / Mag) = 0 Then '１画面終了したらimageクリア
tp = sw.Elapsed
totalsec = tp.TotalSeconds
' Debug.Print("tp.sec=" & totalsec)
sw.Stop()
If totalsec > 0.6 Then
TextBox11.Text = CStr(totalsec)
End If
sw.Reset()
sw.Start()
'Debug.Print("MOD 300:dataNo=" & CStr(dataNo))
SerialPort1.DiscardInBuffer()
PictureBox1.Image = Nothing '1スクロール毎に画面クリア
Else
'====================折れ線PLOT==============================================
'Debug.Print("dataNo=" & CStr(dataNo) & "value=" & CStr(value) & "midvalue=" & CStr(midvalue(0)) & "px=" & CStr(px) & "py=" & CStr(py))
'******************Plot Unit 1ch******************************
If Ch_sel(0) = 1 Then
px = Int((dstep * dataNo Mod CInt(600 / Mag)) * Mag)
px_1 = Int((dstep * (dataNo - 1) Mod CInt(600 / Mag)) * Mag)
py = yh - (Int(rate(0) * (dataAry(dataNo, 0) - midvalue(0))) + TBposition)
'Debug.Print("------1ch_py:dataAry=" & CStr(dataAry(dataNo, 0)) & "midvalue=" & CStr(midvalue(0)))
py_1 = yh - (Int(rate(0) * (dataAry(dataNo - 1, 0) - midvalue(0))) + TBposition)
'Debug.Print("1ch_py_1:dataAry=" & CStr(dataAry(dataNo, 0)) & "midvalue=" & CStr(midvalue(0)))
g.DrawLine(p1, CSng(px_1), CSng(py_1), CSng(px), CSng(py))
'Debug.Print("------1ch:px_1=" & CStr(px_1) & "px=" & CStr(px) & "py_1=" & CStr(py_1) & "py=" & CStr(py))
'g.FillEllipse(b, px, py, 5, 5) ' 点プロット　この位置で動作OK
End If
'**********************************************************
'******************Plot Unit2ch******************************
If Ch_sel(1) = 1 Then
px = Int((dstep * dataNo Mod CInt(600 / Mag)) * Mag)
px_1 = Int((dstep * (dataNo - 1) Mod CInt(600 / Mag)) * Mag)
py = yh - (Int(rate(1) * (dataAry(dataNo, 1) - midvalue(1))) + TBposition)
'Debug.Print("=======2ch_py:dataAry=" & CStr(dataAry(dataNo, 0)) & "midvalue=" & CStr(midvalue(1)))
py_1 = yh - (Int(rate(1) * (dataAry(dataNo - 1, 1) - midvalue(1))) + TBposition)
'Debug.Print("2ch_py_1:dataAry=" & CStr(dataAry(dataNo, 0)) & "midvalue=" & CStr(midvalue(1)))
g.DrawLine(p2, CSng(px_1), CSng(py_1), CSng(px), CSng(py))
'Debug.Print("=====2ch:px_1=" & CStr(px_1) & "px=" & CStr(px) & "py_1=" & CStr(py_1) & "py=" & CStr(py))
End If
'**********************************************************
'******************Plot Unit3ch******************************
If Ch_sel(2) = 1 Then
px = Int((dstep * dataNo Mod CInt(600 / Mag)) * Mag)
px_1 = Int((dstep * (dataNo - 1) Mod CInt(600 / Mag)) * Mag)
py = yh - (Int(rate(2) * (dataAry(dataNo, 2) - midvalue(2))) + TBposition)
py_1 = yh - (Int(rate(2) * (dataAry(dataNo - 1, 2) - midvalue(2))) + TBposition)
g.DrawLine(p3, CSng(px_1), CSng(py_1), CSng(px), CSng(py))
End If
'**********************************************************
'******************Plot Unit4ch******************************
If Ch_sel(3) = 1 Then
px = Int((dstep * dataNo Mod CInt(600 / Mag)) * Mag)
px_1 = Int((dstep * (dataNo - 1) Mod CInt(600 / Mag)) * Mag)
py = yh - (Int(rate(3) * (dataAry(dataNo, 3) - midvalue(3))) + TBposition)
py_1 = yh - (Int(rate(3) * (dataAry(dataNo - 1, 3) - midvalue(3))) + TBposition)
g.DrawLine(p4, CSng(px_1), CSng(py_1), CSng(px), CSng(py))
End If
'**********************************************************
'******************Plot Unit5ch******************************
If Ch_sel(4) = 1 Then
px = Int((dstep * dataNo Mod CInt(600 / Mag)) * Mag)
px_1 = Int((dstep * (dataNo - 1) Mod CInt(600 / Mag)) * Mag)
py = yh - (Int(rate(4) * (dataAry(dataNo, 4) - midvalue(4))) + TBposition)
py_1 = yh - (Int(rate(4) * (dataAry(dataNo - 1, 4) - midvalue(4))) + TBposition)
g.DrawLine(p5, CSng(px_1), CSng(py_1), CSng(px), CSng(py))
End If
'**********************************************************
'******************Plot Unit6ch******************************
If Ch_sel(4) = 1 Then
px = Int((dstep * dataNo Mod CInt(600 / Mag)) * Mag)
px_1 = Int((dstep * (dataNo - 1) Mod CInt(600 / Mag)) * Mag)
py = yh - (Int(rate(5) * (dataAry(dataNo, 5) - midvalue(5))) + TBposition)
py_1 = yh - (Int(rate(5) * (dataAry(dataNo - 1, 5) - midvalue(5))) + TBposition)
g.DrawLine(p6, CSng(px_1), CSng(py_1), CSng(px), CSng(py))
End If
'**********************************************************
'Debug.Print("px_1=" & CStr(px_1) & "px=" & CStr(px) & "py_1=" & CStr(py_1) & "py=1" & CStr(py))
End If
g.Dispose()
'b.Dispose()
PictureBox1.Invalidate()
End If 'Oresen Graph End
'*********************************************************
'*************************Linear View Mode****************
'***************************720x240************************
Dim x1ch, y1ch, x2ch, y2ch, x3ch, y3ch As Integer
ReDim cp1X(600000, 6)
ReDim cp1Y(600000, 6)
ReDim cp2X(600000, 6)
ReDim cp2Y(600000, 6)
ReDim cp3X(600000, 6)
ReDim cp3Y(600000, 6)
'Dim b As Brush
b = Brushes.Black
If CheckBox10.Checked = True Then
'----=WAKU---------------------
g.DrawRectangle(Pens.Black, 0, 0, 239, 239)
g.DrawRectangle(Pens.Black, 241, 0, 479, 239)
g.DrawRectangle(Pens.Black, 480, 0, 719, 239)
'-------Ellipse Color----------------
Select Case ComboBox9.SelectedIndex
Case 0
b = Brushes.Red
Case 1
b = Brushes.Blue
Case 2
b = Brushes.Green
Case 3
b = Brushes.Magenta
Case 4
b = Brushes.Orange
Case 5
b = Brushes.Black
End Select
'--Waku1-------------------------
If TextBox22.Text <> "" And TextBox23.Text <> "" Then
x1ch = CInt(TextBox22.Text) - 1 'array indexNo
y1ch = CInt(TextBox23.Text) - 1
cp1X(dataNo, x1ch) = yh - (Int(rate(x1ch) * (dataAry(dataNo, x1ch) - midvalue(x1ch))) + TBposition)
cp1Y(dataNo, y1ch) = yh - (Int(rate(y1ch) * (dataAry(dataNo, y1ch) - midvalue(y1ch))) + TBposition)
px = cp1X(dataNo, x1ch)
py = cp1Y(dataNo, y1ch)
g.FillEllipse(b, px, py, 3, 3) ' 点プロット
End If
'---Waku2----------------------------
If TextBox24.Text <> "" And TextBox25.Text <> "" Then
Dim xoff As Integer = 240
x2ch = CInt(TextBox24.Text) - 1 'array indexNo
y2ch = CInt(TextBox25.Text) - 1
cp2X(dataNo, x2ch) = yh - (Int(rate(x2ch) * (dataAry(dataNo, x2ch) - midvalue(x2ch))) + TBposition)
cp2Y(dataNo, y2ch) = yh - (Int(rate(y2ch) * (dataAry(dataNo, y2ch) - midvalue(y2ch))) + TBposition)
px = cp2X(dataNo, x2ch) + xoff
py = cp2Y(dataNo, y2ch)
g.FillEllipse(b, px, py, 3, 3) ' 点プロット
End If
'---Waku3----------------------------
If TextBox26.Text <> "" And TextBox27.Text <> "" Then
Dim xoff As Integer = 480
x3ch = CInt(TextBox26.Text) - 1 'array indexNo
y3ch = CInt(TextBox27.Text) - 1
cp3X(dataNo, x3ch) = yh - (Int(rate(x3ch) * (dataAry(dataNo, x3ch) - midvalue(x3ch))) + TBposition)
cp3Y(dataNo, y3ch) = yh - (Int(rate(y3ch) * (dataAry(dataNo, y3ch) - midvalue(y3ch))) + TBposition)
px = cp3X(dataNo, x3ch) + xoff
py = cp3Y(dataNo, y3ch)
g.FillEllipse(b, px, py, 3, 3) ' 点プロット
End If
g.Dispose()
PictureBox1.Invalidate()
End If
End Sub
'********************************************************************************************************************************************************
'=====================================================================================================================
'=====================================================================================================================
'=====================================================================================================================
'========================================================================================
Private Sub Form1_Load(sender As Object, e As EventArgs) Handles Me.Load
'*********************Object Array set****************************************************************************
Dim dataTextBox() As TextBox
dataTextBox = {Me.TextBox4, Me.TextBox5, Me.TextBox6, Me.TextBox7, Me.TextBox8, Me.TextBox9, Me.TextBox10}
Dim adjustComboBox() As ComboBox
adjustComboBox = {Me.ComboBox1, Me.ComboBox2, Me.ComboBox3, Me.ComboBox4, Me.ComboBox5, Me.ComboBox6, Me.ComboBox7}
Dim midTextBox() As TextBox
midTextBox = {Me.TextBox13, Me.TextBox14, Me.TextBox15, Me.TextBox16, Me.TextBox17, Me.TextBox18, Me.TextBox19}
'******************************************************************************************************************
'Dim arry() As Integer = {0, 10, 20, 30, 40, 50, 60, 70, 80, 90, 100}
'================COMBOBOX Def=============================
ComboBox1.Items.Clear()
Dim n As Integer
For i = 0 To 6
adjustComboBox(i).Items.Add("0.1") '0.1mv/yh_DOT
adjustComboBox(i).Items.Add("0.2")
adjustComboBox(i).Items.Add("0.5")
adjustComboBox(i).Items.Add("1") '1mv?yh?DOT
adjustComboBox(i).Items.Add("2")
adjustComboBox(i).Items.Add("5")
adjustComboBox(i).Items.Add("10") '10mV/yh_DOT
adjustComboBox(i).Items.Add("20")
adjustComboBox(i).Items.Add("50") '50mV?yh_DOT
'adjustComboBox(i).Items.Add("90")
'adjustComboBox(i).Items.Add("100")
Next
ComboBox1.SelectedIndex = 3
ComboBox2.SelectedIndex = 3
ComboBox3.SelectedIndex = 3
ComboBox4.SelectedIndex = 3
ComboBox5.SelectedIndex = 3
ComboBox6.SelectedIndex = 3
'ComboBox7.SelectedIndex = 1
'==============Series Position TEXTBOX===========================
TextBox13.Text = CStr(1550)
TextBox14.Text = CStr(1550)
TextBox15.Text = CStr(1550)
TextBox16.Text = CStr(1550)
TextBox17.Text = CStr(1550)
TextBox18.Text = CStr(1550)
TextBox19.Text = CStr(1550)
'============================CheckBox On================================-
CheckBox1.Checked = True
CheckBox2.Checked = True
CheckBox3.Checked = True
CheckBox4.Checked = True
CheckBox5.Checked = True
CheckBox6.Checked = True
'==================COMBOBOX8 X_Mag scale=================================
'===============1,2,3,4,5,6,10,12==================================
ComboBox8.Items.Add("0.01")
ComboBox8.Items.Add("0.1")
ComboBox8.Items.Add("0.2")
ComboBox8.Items.Add("0.5")
ComboBox8.Items.Add("1")
ComboBox8.Items.Add("2")
ComboBox8.Items.Add("3")
ComboBox8.Items.Add("4")
ComboBox8.Items.Add("5")
ComboBox8.Items.Add("6")
ComboBox8.Items.Add("10")
ComboBox8.Items.Add("12")
ComboBox8.SelectedIndex = 5
'===================TrackBar read========================
Dim TBvalue As Integer
TBvalue = TrackBar1.Value
TextBox20.Text = CStr(TBvalue)
'===========Receive check==============
CheckBox9.Checked = True
Button2.Enabled = False
'======Color Combobox ============================
ComboBox9.Items.Add(Color.Red)
ComboBox9.Items.Add(Color.Blue)
ComboBox9.Items.Add(Color.Green)
ComboBox9.Items.Add(Color.Magenta)
ComboBox9.Items.Add(Color.Orange)
ComboBox9.Items.Add(Color.Black)
'============USB Serial Ports Search=============
For Each sp As String In My.Computer.Ports.SerialPortNames
ComboBox10.Items.Add(sp)
ComboBox11.Items.Add(sp)
Next
ComboBox10.Items.Add("None")
ComboBox11.Items.Add("None")
End Sub
'========================================================================
'================Average Graph mid Data==================================
'========================================================================
Private Sub Button5_Click(sender As Object, e As EventArgs) Handles Button5.Click
Dim endnum As Integer
Dim startnum As Integer
Dim midave(7) As Double
endnum = CInt(TextBox2.Text)
startnum = endnum - 100
midave = dave(dataAry, startnum, endnum, 6)
'Debug.Print("AveButtn:" & CStr(startnum) & "," & CStr(endnum) & "," & CStr(midave(0)))
TextBox13.Text = midave(0)
TextBox14.Text = midave(1)
TextBox15.Text = midave(2)
TextBox16.Text = midave(3)
TextBox17.Text = midave(4)
TextBox18.Text = midave(5)
End Sub
'==========================PLOTTING Parameter Check ===============================================
'===================dataAry(,)=mV rate()=dot/mv=1/adjutvalue()(=mV/dot)============================================
'=================== plot: py=(dataAry(,)-midvalue())*rate()+midvalue()==============================================
Private Sub Button6_Click(sender As Object, e As EventArgs) Handles Button6.Click
Dim m, n As Integer
Dim px, py As Integer
Dim dn, ds, de As Integer
ReDim rate(8)
ReDim midvalue(8)
'For m = 0 To 6
' rate(m) = 1 / CInt(adjustComboBox(m).Text)
' midvalue(m) = CDbl(midTextBox(m).Text)
'Next
dn = CInt(TextBox2.Text) '現在データＮｏ
ds = CInt(dn / 600) * 600 '左始点データスタートＮＯ
de = dn Mod 600 '現在座標
'Debug.Print("dn=" & CStr(dn) & "ds=" & CStr(ds) & "de=" & CStr(de))
For n = 0 To 5
For m = 0 To de
px = m
py = CInt((CDbl(dataAry(ds + m, n)) - midvalue(n)) * rate(n) / 100 + yh / 2)
'Debug.Print("m=" & CStr(m) & "n=" & CStr(n) & "dataAry=" & CStr(dataAry(ds + m, n)) & "midvalue=" & CStr(midvalue(n)) & "sa=" & CStr((CDbl(dataAry(ds + m, n)) - midvalue(n))) & "rate=" & rate(n) & "Plotting:px=" & CStr(px) & "py=" & CStr(py))
'Debug.Print("Plotting:px=" & CStr(px) & "py=" & CStr(py))
Next
Next
End Sub
'********************************************************************************************************************
'*********************************FORM Reading Functions*************************************************************
'*******************************************************************************************************************
Private Function AvTR() As Double()
Dim ave(7) As Double
ave(0) = CDbl(TextBox13.Text)
ave(1) = CDbl(TextBox14.Text)
ave(2) = CDbl(TextBox15.Text)
ave(3) = CDbl(TextBox16.Text)
ave(4) = CDbl(TextBox17.Text)
ave(5) = CDbl(TextBox18.Text)
ave(6) = CDbl(TextBox19.Text)
Return ave
End Function
Private Function RateCR() As Double()
Dim rate(7) As Double
rate(0) = CDbl(ComboBox1.SelectedItem) 'mv/dot
rate(1) = CDbl(ComboBox2.SelectedItem)
rate(2) = CDbl(ComboBox3.SelectedItem)
rate(3) = CDbl(ComboBox4.SelectedItem)
rate(4) = CDbl(ComboBox5.SelectedItem)
rate(5) = CDbl(ComboBox6.SelectedItem)
rate(6) = CDbl(ComboBox7.SelectedItem)
Return rate
End Function
Private Function CheckBR() As Integer()
Dim selCh() As Integer = {0, 0, 0, 0, 0, 0, 0}
If CheckBox1.Checked = True Then
selCh(0) = 1
End If
If CheckBox2.Checked = True Then
selCh(1) = 1
End If
If CheckBox3.Checked = True Then
selCh(2) = 1
End If
If CheckBox4.Checked = True Then
selCh(3) = 1
End If
If CheckBox5.Checked = True Then
selCh(4) = 1
End If
If CheckBox6.Checked = True Then
selCh(5) = 1
End If
If CheckBox7.Checked = True Then
selCh(6) = 1
End If
Return selCh
End Function
'*******************************************************************************************************************
'*******************************************************************************************************************
'*******************************************************************************************************************
'==================================================================================================================
'==================================Static Calculation===========================================================
'==========================Ave() MovingAve() ============================================================
'==================================================================================================================
'==================================================================================================================
Function dave(ByRef dA(,) As Long, ByVal startN As Integer, ByVal endN As Integer, ByVal ch As Integer) As Double()
Dim chN As Integer
Dim dataN As Integer
Dim dsum As Double
Dim avech() As Double
ReDim avech(ch)
For chN = 0 To ch - 1 'chは１－６ｃｈで与えられるがデータindexは０－５
For dataN = startN To endN 'startNからendNまでendN-startN+1 個の総和をとって平均
dsum += dA(dataN, chN)
Next
avech(chN) = dsum / (endN - startN + 1)
dsum = 0
Next
Return avech
End Function
Function MovAve(ByRef dA(,) As Long, ByVal colN As Integer, ByVal MA As Integer, ByVal rowN As Integer) As Double()
Dim i, j As Integer
Dim dataSum() As Long
Dim dSum As Long
Dim dataA() As Double '= {0, 0, 0, 0, 0, 0, 0}
'Debug.Print("====colN=" & CStr(colN) & "MA=" & CStr(MA) & "rowN=" & CStr(rowN))
ReDim dataSum(colN + 1)
ReDim dataA(colN + 1)
For j = 0 To colN - 1
dSum = 0
For i = rowN - MA To rowN
dSum = dSum + dA(i, j)
'Debug.Print("dA(" & CStr(i) & "," & CStr(j) & ")=" & CStr(dA(i, j)) & CStr(dataSum(j)))
Next
dataA(j) = CDbl(dSum / MA)
Next
MovAve = dataA
End Function
Sub AutoFileLog()
End Sub
Private Sub Button7_Click(sender As Object, e As EventArgs) Handles Button7.Click
'===================FILE Name=================
'------FILE SAVE----------------------
Dim sfd As New SaveFileDialog()
Dim fname As String
fname = Format(Now, "yyyyMMdd_HHmmss")
' Debug.Print("fname=" & fname)
sfd.FileName = fname
sfd.Filter = "TXTファイル|*.txt|CSVファイル|*.csv|すべてのファイル|*.*"
sfd.InitialDirectory = "C:\vb_LOG "
sfd.FilterIndex = 2
sfd.Title = "保存先のファイルを選択してください"
If sfd.ShowDialog() = DialogResult.OK Then
'OKボタンがクリックされたとき、選択されたファイル名を表示する
Console.WriteLine(sfd.FileName)
TextBox21.Text = sfd.FileName
End If
''====================================================
''SaveFileDialogクラスのインスタンスを作成
'Dim sfd As New SaveFileDialog()
''はじめのファイル名を指定する
''はじめに「ファイル名」で表示される文字列を指定する
'sfd.FileName = "新しいファイル.html"
''はじめに表示されるフォルダを指定する
''指定しない（空の文字列）の時は、現在のディレクトリが表示される
'sfd.InitialDirectory = "C:\"
''[ファイルの種類]に表示される選択肢を指定する
'sfd.Filter = "HTMLファイル(*.html;*.htm)|*.html;*.htm|すべてのファイル(*.*)|*.*"
''[ファイルの種類]ではじめに選択されるものを指定する
''2番目の「すべてのファイル」が選択されているようにする
'sfd.FilterIndex = 2
''タイトルを設定する
'sfd.Title = "保存先のファイルを選択してください"
''ダイアログボックスを閉じる前に現在のディレクトリを復元するようにする
'sfd.RestoreDirectory = True
''既に存在するファイル名を指定したとき警告する
''デフォルトでTrueなので指定する必要はない
'sfd.OverwritePrompt = True
''存在しないパスが指定されたとき警告を表示する
''デフォルトでTrueなので指定する必要はない
'sfd.CheckPathExists = True
''ダイアログを表示する
'If sfd.ShowDialog() = DialogResult.OK Then
' 'OKボタンがクリックされたとき、選択されたファイル名を表示する
' Console.WriteLine(sfd.FileName)
'End If
End Sub
Private Sub TrackBar1_MouseDown(sender As Object, e As MouseEventArgs) Handles TrackBar1.MouseDown
'Debug.Print("Mouse Downed")
End Sub
'============ Auto File save CheckBox8====================================
Private Sub CheckBox8_CheckedChanged(sender As Object, e As EventArgs) Handles CheckBox8.CheckedChanged
If CheckBox8.Checked = False Then
fname = ""
TextBox21.Text = ""
'If System.IO.File.Exists(fname) Then
file.Close()
Label7.Text = "FileClosed"
' End If
End If
End Sub
'=========Receiving CheckBox===============================
Private Sub CheckBox9_CheckedChanged(sender As Object, e As EventArgs) Handles CheckBox9.CheckedChanged
If CheckBox9.Checked = False Then
Button2.Enabled = True
Else
Button2.Enabled = False
End If
End Sub
Private Sub Label10_Click(sender As Object, e As EventArgs) Handles Label10.Click
End Sub
Private Sub Button8_Click(sender As Object, e As EventArgs)
End Sub
'====Linearuty MODE Controls Visible===============
Private Sub CheckBox10_CheckedChanged(sender As Object, e As EventArgs) Handles CheckBox10.CheckedChanged
If CheckBox10.Checked = True Then
TextBox22.Visible = True
TextBox23.Visible = True
TextBox24.Visible = True
TextBox25.Visible = True
TextBox26.Visible = True
TextBox27.Visible = True
Label11.Visible = True
Label12.Visible = True
Label13.Visible = True
Label14.Visible = True
Label15.Visible = True
Label16.Visible = True
Label17.Visible = True
Label18.Visible = True
Label19.Visible = True
End If
If CheckBox10.Checked = False Then
TextBox22.Visible = False
TextBox23.Visible = False
TextBox24.Visible = False
TextBox25.Visible = False
TextBox26.Visible = False
TextBox27.Visible = False
Label11.Visible = False
Label12.Visible = False
Label13.Visible = False
Label14.Visible = False
Label15.Visible = False
Label16.Visible = False
Label17.Visible = False
Label18.Visible = False
Label19.Visible = False
End If
End Sub
Private Sub Button8_Click_1(sender As Object, e As EventArgs) Handles Button8.Click
PictureBox1.Image = Nothing '1スクロール毎に画面クリア
End Sub
Private Sub ComboBox9_SelectedIndexChanged(sender As Object, e As EventArgs) Handles ComboBox9.SelectedIndexChanged
Select Case ComboBox9.SelectedIndex
Case 0
ComboBox9.BackColor = Color.Red
ComboBox9.ForeColor = Color.Red
Case 1
ComboBox9.BackColor = Color.Blue
ComboBox9.ForeColor = Color.Blue
Case 2
ComboBox9.BackColor = Color.Green
ComboBox9.ForeColor = Color.Green
Case 3
ComboBox9.BackColor = Color.Magenta
ComboBox9.ForeColor = Color.Magenta
Case 4
ComboBox9.BackColor = Color.Orange
ComboBox9.ForeColor = Color.Orange
Case 5
ComboBox9.BackColor = Color.Black
ComboBox9.ForeColor = Color.Black
End Select
End Sub
Private Sub ComboBox9_Click(sender As Object, e As EventArgs) Handles ComboBox9.Click
ComboBox9.ForeColor = Color.Gray
End Sub
'==========Comment MEMO=====================================
Private Sub Button10_Click(sender As Object, e As EventArgs)
End Sub
Private Sub RichTextBox1_TextChanged(sender As Object, e As EventArgs) Handles RichTextBox1.TextChanged
'-------Ellipse Color----------------
Select Case ComboBox9.SelectedIndex
Case 0
RichTextBox1.SelectionColor = Color.Red
Case 1
RichTextBox1.SelectionColor = Color.Blue
Case 2
RichTextBox1.SelectionColor = Color.Green
Case 3
RichTextBox1.SelectionColor = Color.Magenta
Case 4
RichTextBox1.SelectionColor = Color.Orange
Case 5
RichTextBox1.SelectionColor = Color.Black
End Select
End Sub
Private Shared _form1Instance As Form1
'Form1オブジェクトを取得、設定するためのプロパティ
End Class
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment