Created
November 24, 2021 01:18
-
-
Save dj1711572002/fa2baf2d24cf23c6aff06e629b6ab055 to your computer and use it in GitHub Desktop.
VB.NET RealTimeGraph DataGridView Log and CSV save
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| 'Serial Port Recieve Sample Program | |
| 'Form1 Object must create ,button1,2 & textbox 1,2 | |
| Imports System.IO.Ports | |
| Imports System.Drawing | |
| Public Class Form1 | |
| '=============File declarations ================ | |
| Public file As System.IO.StreamWriter | |
| Public file1 As System.IO.StreamWriter | |
| Public fileH As System.IO.StreamWriter | |
| Public file_dgv As System.IO.StreamWriter | |
| Dim dArr(500000) As String | |
| Dim arr1() As String | |
| Dim rn, rn_start, rn_pause As Integer | |
| Dim sflag As Integer | |
| Dim longBitmap As New Bitmap(60000, 400) | |
| Dim sourceBitmap As New Bitmap(1600, 400) 'X軸30000data(10msec周期で300秒） Y軸3300data（電圧3300mV) | |
| Dim xyBitmap As New Bitmap(400, 400) '重心位置プロット用BITMAP | |
| Dim trimmedBitmap As New Bitmap(800, 400) 'PictuerBox1に貼りこむBitmap | |
| Dim cursorBitmap As New Bitmap(longBitmap) 'Cursor用BitmapをlongBitmapをコピーして作成 | |
| Dim ctrimBitmap As New Bitmap(800, 400) 'Curor用切取りBitmap | |
| Dim data1(60000) As Double | |
| Dim data2(60000) As Double | |
| Dim data3(60000) As Double | |
| Dim pageN As Integer | |
| Dim sourceN As Integer | |
| Dim datastr As String | |
| Dim pW As Integer = 800 | |
| Dim pH As Integer = 400 | |
| Dim px, px0, px00 As Integer | |
| Dim fz As Integer | |
| Dim momx As Integer | |
| Dim momy As Integer | |
| Dim px_1 As Integer | |
| Dim py0, py0_1 As Integer | |
| Dim py1, py1_1 As Integer | |
| Dim py2, py2_1 As Integer | |
| Dim py00, py00_1 As Integer | |
| Dim py01, py01_1 As Integer | |
| Dim py02, py02_1 As Integer | |
| Dim longX As Integer | |
| Dim startX As Integer | |
| Dim leftEnd As Integer | |
| 'Scaling | |
| Dim xScale, yScale As Double | |
| 'averaging | |
| Dim sum0, sum1, sum2 As Double | |
| Dim ave0, ave1, ave2 As Double | |
| Dim GX As Integer | |
| Dim GY As Integer | |
| Dim pauseFlag As Integer | |
| Dim scrollFlag As Integer | |
| 'Corsor Graphic | |
| Dim cRx, cLx As Integer | |
| Dim cRx_1, cLx_1 As Integer | |
| Dim cRy(8) As Integer | |
| Dim cLy(8) As Integer | |
| Dim cRflag, cLflag As Integer | |
| Dim dw As Integer | |
| Dim clickN As Integer | |
| Dim cRlongX, cLlongX As Integer | |
| Dim vRx, vLx As Integer 'カーソルの絶対X座標 | |
| Dim vSy As Integer = 200 | |
| 'dgv初期設定 | |
| Private Sub Form1_Load(ByVal sender As Object, ByVal e As System.EventArgs) Handles MyBase.Load | |
| For Each sp As String In My.Computer.Ports.SerialPortNames | |
| ComboBox1.Items.Add(sp) | |
| Next | |
| PictureBox1.Width = 800 | |
| PictureBox1.Height = 400 | |
| 'dgv1.AutoSizeColumnsMode = DataGridViewAutoSizeColumnsMode.AllCells 'セル幅を自動調整 | |
| dgv1.ClipboardCopyMode = DataGridViewClipboardCopyMode.EnableWithoutHeaderText | |
| dgv1.RowHeadersWidth = 60 | |
| dgv1.ColumnCount = 16 | |
| dgv1.RowCount = 1 | |
| 'dgv1.Rows.Add("CH数", "", "COM No", " ", "BaudRate", "115200") | |
| Button1.Enabled = True | |
| Button2.Enabled = False | |
| Button3.Enabled = False | |
| CheckBox1.Checked = True | |
| '--------Graphic Initialize------------------------ | |
| sum0 = 0 | |
| sum1 = 0 | |
| sum2 = 0 | |
| '-----hScrollbar1--------------------------------- | |
| HScrollBar1.Minimum = 0 | |
| 'VScrollbar | |
| Label10.Text = 200 | |
| 'Scaling init | |
| xScale = 1 | |
| yScale = 1 | |
| ComboBox2.SelectedIndex = 4 | |
| ComboBox3.SelectedIndex = 7 | |
| End Sub | |
| 'dgv save | |
| Private Sub Button5_Click(sender As Object, e As EventArgs) Handles Button5.Click | |
| Dim fnameH As String | |
| Dim fStr1 As String | |
| Dim fstr2 As String | |
| Dim f1open As Integer | |
| '---------dgv SCPmode保存ファイル準備------------------------------ | |
| fnameH = Format(Now, "yyyyMMdd_HHmmss") | |
| fStr1 = "data_" 'ComboBox9.SelectedItem.ToString() | |
| fnameH = "C:\BitmapGraph\" & fStr1 & fnameH & ".csv" | |
| fstr2 = "FileOpen:" + fnameH | |
| ' RichTextBox1.AppendText(fStr2) | |
| ' RichTextBox1.ScrollToCaret() | |
| Dim enc As System.Text.Encoding = System.Text.Encoding.GetEncoding(“Shift_JIS”) | |
| file_dgv = My.Computer.FileSystem.OpenTextFileWriter(fnameH, False, enc) | |
| f1open = 1 | |
| Label3.Text = fnameH | |
| 'dgN = ComboBox37.SelectedIndex | |
| '--------dgvから読んでファイル保存----------------------- | |
| Dim SCPheadstr As String = "" | |
| '---Header Str Save------------------ | |
| For i = 0 To dgv1.ColumnCount - 1 | |
| SCPheadstr += dgv1.Columns(i).HeaderText + "," | |
| Next i | |
| SCPheadstr += vbCrLf | |
| file_dgv.Write(SCPheadstr) | |
| '----------LoadNo,X,Y,Z save------------ | |
| Dim SCPstr As String = "" | |
| For i = 0 To dgv1.RowCount - 1 | |
| 'If CStr(dgv(dgN).Rows(i).Cells(0).Value) <> "" Then | |
| '---Header Str Save------------------ | |
| For j = 0 To dgv1.ColumnCount - 1 | |
| SCPstr += CStr(dgv1.Rows(i).Cells(j).Value) + "," | |
| 'End If | |
| Next j | |
| SCPstr += vbCrLf | |
| file_dgv.Write(SCPstr) | |
| SCPstr = "" | |
| Next i | |
| file_dgv.Close() | |
| f1open = 0 | |
| End Sub | |
| Private Sub Label3_Click(sender As Object, e As EventArgs) Handles Label3.Click | |
| End Sub | |
| Private Sub ComboBox2_SelectedIndexChanged(sender As Object, e As EventArgs) Handles ComboBox2.SelectedIndexChanged | |
| xScale = CDbl(ComboBox2.SelectedItem) | |
| End Sub | |
| Private Sub VScrollBar1_Scroll(sender As Object, e As ScrollEventArgs) Handles VScrollBar1.Scroll | |
| vSy = VScrollBar1.Value | |
| Label10.Text = CStr(vSy) | |
| End Sub | |
| Private Sub ComboBox3_SelectedIndexChanged(sender As Object, e As EventArgs) Handles ComboBox3.SelectedIndexChanged | |
| yScale = CDbl(ComboBox3.SelectedItem) / 100 '%から実数 | |
| End Sub | |
| Private Sub Label8_Click(sender As Object, e As EventArgs) Handles Label8.Click | |
| End Sub | |
| Delegate Sub DataDelegate(ByVal sdata As String) | |
| Private Sub RadioButton3_CheckedChanged(sender As Object, e As EventArgs) Handles RadioButton3.CheckedChanged | |
| If RadioButton3.Checked = True Then | |
| dgv1.Visible = False | |
| PictureBox1.Visible = True | |
| PictureBox2.Visible = True | |
| End If | |
| End Sub | |
| Private Sub HScrollBar1_Scroll(sender As Object, e As ScrollEventArgs) Handles HScrollBar1.Scroll | |
| scrollFlag = 1 | |
| If pauseFlag = 1 Then | |
| Dim hx As Integer = HScrollBar1.Value 'スクロールバーの値でPictureBox1の右端位置 | |
| If hx - 800 > 0 Then | |
| longX = hx - PictureBox1.Width | |
| TextBox2.Text = hx | |
| Dim g0 As Graphics = Graphics.FromImage(longBitmap) ' longBitmapへ書き込むグラフィック処理名g1 | |
| Dim g2 As Graphics = Graphics.FromImage(trimmedBitmap) 'trimmedBitmapへ書き込むグラフィック処理名g2 | |
| g2.Clear(Color.Black) | |
| 'If rn > 800 Then | |
| Dim srcHeight0 As Integer | |
| Dim srcHeight1 As Integer | |
| Dim srcWidth As Integer | |
| If yScale > 1 Or xScale > 1 Then | |
| Dim halfHeight As Integer = Int(PictureBox1.Height / (yScale * 2)) | |
| srcHeight0 = 200 - halfHeight | |
| srcHeight1 = 200 + halfHeight | |
| srcWidth = Int(800 * xScale) | |
| Else | |
| srcHeight0 = 0 | |
| srcHeight1 = 400 | |
| srcWidth = 800 | |
| End If | |
| HScrollBar1.Visible = True | |
| Label7.Text = "Hscrollhx_longX=" & CStr(longX) & "startX=" & CStr(startX) | |
| Dim srcRect As New Rectangle(hx - 800, srcHeight0, srcWidth, srcHeight1) 'ソースから切り取る四角の定義 | |
| Dim desRect As New Rectangle(0, 0, 800, 400) '切り取った四角を貼りこむ四角の定義=>今回はソースと同じサイズなので等倍コピー | |
| If cRflag = 0 Or cLflag = 0 Then | |
| g2.DrawImage(longBitmap, desRect, srcRect, GraphicsUnit.Pixel) | |
| Else | |
| g2.DrawImage(cursorBitmap, desRect, srcRect, GraphicsUnit.Pixel) | |
| End If | |
| ' Else | |
| ' HScrollBar1.Visible = False | |
| ' End If | |
| ' trimmedBitmap.RotateFlip(RotateFlipType.Rotate180FlipX) | |
| PictureBox1.Image = trimmedBitmap | |
| End If | |
| Else | |
| longX = 0 | |
| End If | |
| End Sub | |
| Private Sub RadioButton2_CheckedChanged_1(sender As Object, e As EventArgs) Handles RadioButton2.CheckedChanged | |
| If RadioButton2.Checked = True Then | |
| dgv1.Visible = True | |
| PictureBox1.Visible = True | |
| PictureBox2.Visible = False | |
| Dim ri, rc As Integer | |
| rc = dgv1.Rows.Count - 2 | |
| If rc > 2 Then | |
| For ri = rc To 1 Step -1 | |
| 'Debug.Print("ri=" & CStr(ri) & "rc=" & CStr(rc)) | |
| dgv1.Rows.RemoveAt(ri) | |
| Next ri | |
| dgv1.Rows.RemoveAt(0) | |
| End If | |
| End If | |
| End Sub | |
| Private Sub RadioButton1_CheckedChanged_1(sender As Object, e As EventArgs) Handles RadioButton1.CheckedChanged | |
| If RadioButton1.Checked = True Then | |
| dgv1.Visible = True | |
| PictureBox1.Visible = True | |
| PictureBox2.Visible = False | |
| End If | |
| End Sub | |
| '================================DATA 表示============================================================== | |
| Private Sub PrintData(ByVal sdata As String) | |
| If scrollFlag = 0 And pauseFlag = 0 Then | |
| rn = rn + 1 '行番号 rn | |
| TextBox1.Text = rn | |
| If rn > 800 Then | |
| HScrollBar1.Visible = True | |
| Else | |
| HScrollBar1.Visible = False | |
| End If | |
| ' TextBox2.Text = rn | |
| '---シリアル受信データをカンマ区切りで配列にばらす | |
| dArr(rn) = sdata | |
| Dim cnmastr() As String = sdata.Split(vbCrLf) 'crlf区切りで切取り | |
| If cnmastr(0).Length > 2 Then | |
| datastr = cnmastr(0) | |
| Else | |
| datastr = cnmastr(1) | |
| End If | |
| 'hscrollbar1 セット | |
| HScrollBar1.Maximum = rn | |
| HScrollBar1.Value = rn | |
| sourceN = Int(rn / 1600) | |
| If cnmastr.Length > 1 Then | |
| arr1 = datastr.Split(",") 'カンマ区切りで切り取り | |
| '----data1,data2,data3 保存-------------- | |
| data1(rn) = CDbl(arr1(0)) | |
| data2(rn) = CDbl(arr1(1)) | |
| data3(rn) = CDbl(arr1(2)) | |
| '---初回3秒間でゼロ レベル平均計算------------------------------------- | |
| Dim i, j As Integer | |
| If rn < 200 And rn > 99 Then | |
| sum0 = sum0 + CDbl(arr1(0)) | |
| sum1 = sum1 + CDbl(arr1(1)) | |
| sum2 = sum2 + CDbl(arr1(2)) | |
| End If | |
| If rn = 199 Then | |
| ave0 = sum0 / 100 | |
| ave1 = sum1 / 100 | |
| ave2 = sum2 / 100 | |
| 'Label3.Text = CStr(ave0) + "," + CStr(ave1) + "," + CStr(ave2) | |
| sum0 = 0 | |
| sum1 = 0 | |
| sum2 = 0 | |
| End If | |
| '重心計算用電圧生データ保持 | |
| If rn > 200 Then | |
| 'py00_1 = py00 | |
| 'py01_1 = py01 | |
| 'py02_1 = py02 | |
| 'py00 = System.Math.Abs(Int(arr1(0） - ave0)) + pH / 2 | |
| 'py01 = System.Math.Abs(Int(arr1(1） - ave1)) + pH / 2 | |
| 'py02 = System.Math.Abs(Int(arr1(2） - ave2)) + pH / 2 | |
| Debug.Print("py00,py01,py02=", CStr(py00) & "," & CStr(py01) & "," & CStr(py02)) | |
| '=======グラフ描画============================================================================================== | |
| ' px = Int(rn / xScale) '時間軸調整 | |
| 'px = rn | |
| 'px = px Mod 1600 'sourceBitmap 幅で折り返し | |
| 'Debug.Print("arr1=" & CStr(arr1(0)) & "," & CStr(arr1(1)) & "," & CStr(arr1(2))) | |
| 'Debug.Print("ave=" & CStr(ave0) & "," & CStr(ave1) & "," & CStr(ave2)) | |
| 'Debug.Print("py0=" & CStr(py00) & "," & CStr(py01) & "," & CStr(py02)) | |
| ''グラフ用の座標計算 | |
| 'py0_1 = py0 | |
| 'py1_1 = py1 | |
| 'py2_1 = py2 | |
| 'py0 = System.Math.Abs(Int((arr1(0) - ave0) * yScale)) + vSy ' pH / 2 | |
| 'py1 = System.Math.Abs(Int((arr1(1) - ave1) * yScale)) + vSy ' pH / 2 | |
| 'py2 = System.Math.Abs(Int((arr1(2) - ave2) * yScale)) + vSy ' pH / 2 | |
| 'py0 = pH - py0 | |
| 'py1 = pH - py1 | |
| 'py2 = pH - py2 | |
| Debug.Print("py0,1,2=" & CStr(py0) & "," & CStr(py1) & "," & CStr(py2)) | |
| 'Graphic 定義 | |
| Dim g0 As Graphics = Graphics.FromImage(longBitmap) ' longBitmapへ書き込むグラフィック処理名g1 | |
| Dim g1 As Graphics = Graphics.FromImage(sourceBitmap) ' sourceBitmapへ書き込むグラフィック処理名g1 | |
| Dim g2 As Graphics = Graphics.FromImage(trimmedBitmap) 'trimmedBitmapへ書き込むグラフィック処理名g2 | |
| Dim g3 As Graphics = Graphics.FromImage(xyBitmap) 'xyBitmapへ書き込むグラフィック処理名g3 | |
| '---PLOT Graph DrawLineでプロット----------------------------------------------------------------------------- | |
| '間引き ｘScale毎 | |
| If xScale > 1 And rn Mod xScale = 0 Then | |
| px += 1 | |
| px = px Mod 1600 | |
| py0_1 = py0 | |
| py1_1 = py1 | |
| py2_1 = py2 | |
| py0 = System.Math.Abs(Int((arr1(0) - ave0) * yScale)) + vSy ' pH / 2 | |
| py1 = System.Math.Abs(Int((arr1(1) - ave1) * yScale)) + vSy ' pH / 2 | |
| py2 = System.Math.Abs(Int((arr1(2) - ave2) * yScale)) + vSy ' pH / 2 | |
| py0 = pH - py0 | |
| py1 = pH - py1 | |
| py2 = pH - py2 | |
| g1.DrawLine(Pens.Blue, px, pH - py0, px - 1, pH - py0_1) | |
| g1.DrawLine(Pens.Red, px, pH - py1, px - 1, pH - py1_1) | |
| g1.DrawLine(Pens.LawnGreen, px, pH - py2, px - 1, pH - py2_1) | |
| End If | |
| 'long書き込み 間引き無し | |
| px00 = rn Mod 60000 | |
| 'グラフ用の座標計算 | |
| py00_1 = py00 | |
| py01_1 = py01 | |
| py02_1 = py02 | |
| py00 = System.Math.Abs(Int((arr1(0) - ave0) * yScale)) + vSy ' pH / 2 | |
| py01 = System.Math.Abs(Int((arr1(1) - ave1) * yScale)) + vSy ' pH / 2 | |
| py02 = System.Math.Abs(Int((arr1(2) - ave2) * yScale)) + vSy ' pH / 2 | |
| py00 = pH - py00 | |
| py01 = pH - py01 | |
| py02 = pH - py02 | |
| Dim p0Blue As Pen = New Pen(Color.Blue, 2) | |
| Dim p0Red As Pen = New Pen(Color.Red, 2) | |
| Dim p0LG As Pen = New Pen(Color.LawnGreen, 2) | |
| g0.DrawLine(p0Blue, px00, pH - py00, px00 - 1, pH - py00_1) | |
| g0.DrawLine(p0Red, px00, pH - py01, px00 - 1, pH - py01_1) | |
| g0.DrawLine(p0LG, px00, pH - py02, px00 - 1, pH - py02_1) | |
| '---xyBitmapへ重心データをDrasString,DrawEllipseでプロットする------------------------------------------------- | |
| '干渉補正式 フォースプレートの3脚を水平置きした場合 | |
| 'Fz=-113.628361*py00-112.656511781532*py01-120.675523190567*py02 | |
| 'Mx=2383.06302121186*py00+27295.3846708116*py01-29156.1922193617*py02 | |
| 'My=32246.1494336958*py00-18597.2104901168*py01-14272.2084921559*py02 | |
| 'ｘｙBitmap 座標軸プロット | |
| For i = 0 To 8 | |
| g3.DrawLine(Pens.LawnGreen, 0, 50 * i, 400, 50 * i) 'X軸 | |
| g3.DrawLine(Pens.LawnGreen, 50 * i, 0, 50 * i, 400) 'Y軸 | |
| Next i | |
| g3.DrawEllipse(Pens.Red, 200 - 10, 200 - 10, 20, 20) | |
| 'ｘｙBitmapの座標 | |
| Dim width_xy As Integer = 400 | |
| Dim height_xy As Integer = 400 | |
| Dim centerX As Integer = 200 | |
| Dim centerY As Integer = 200 | |
| If RadioButton3.Checked = True Then | |
| fz = Int(-113.628361 * py00 - 112.656511781532 * py01 - 120.675523190567 * py02) | |
| momx = Int(2383.06302121186 * py00 + 27295.3846708116 * py01 - 29156.1922193617 * py02) | |
| momy = Int(32246.1494336958 * py00 - 18597.2104901168 * py01 - 14272.2084921559 * py02) | |
| If fz < 30 Then | |
| fz = 0 | |
| GX = 0 | |
| GY = 0 | |
| Else | |
| GX = Int(momy / fz) | |
| GY = Int(momx / fz) | |
| End If | |
| If rn Mod 5 = 0 Then | |
| 'DrawStting | |
| Dim fnt As New Font("MS UI Gothic", 12) | |
| g3.FillRectangle(Brushes.Black, 0, 0, 300, 50) | |
| g3.DrawString("Fz(g)=" & fz.ToString("0"), fnt, Brushes.Red, 0, 0) | |
| g3.DrawString("GX(mm)=" & GX.ToString("0"), fnt, Brushes.Red, 100, 0) | |
| g3.DrawString("GY(mm)=" & GY.ToString("0"), fnt, Brushes.Red, 200, 0) | |
| '重心位置プロット | |
| g3.FillEllipse(Brushes.Red, GX + centerX - 10, GY + centerY - 10, 20, 20) | |
| 'bitmap反転 | |
| 'xyBitmap.RotateFlip(RotateFlipType.Rotate180FlipX) | |
| End If | |
| End If | |
| If px Mod 1600 = 0 Then 'rn=pWの整数倍になった時に切取りX座標変更 | |
| pageN += 1 'ページ番号 | |
| 'TextBox2.Text = pageN | |
| g1.Clear(Color.Black) | |
| g2.Clear(Color.Black) | |
| End If | |
| '開始座標の切り分け | |
| If px > pW Then | |
| startX = px - pW | |
| Else | |
| startX = 0 | |
| End If | |
| ' longX = sourceN * 1600 + startX | |
| '切取り四角の定義 | |
| Label7.Text = "PrintData_longtX=" & CStr(longX) & "startX=" & CStr(startX) | |
| Dim srcRect As New Rectangle(startX, 0, 800, 400) 'ソースから切り取る四角の定義 | |
| Dim desRect As New Rectangle(0, 0, 800, 400) '切り取った四角を貼りこむ四角の定義=>今回はソースと同じサイズなので等倍コピー | |
| 'Dim xyRect As New Rectangle(0, 0, leftEnd, 400) | |
| g2.DrawImage(sourceBitmap, desRect, srcRect, GraphicsUnit.Pixel) | |
| 'trimmedBitmap.RotateFlip(RotateFlipType.Rotate180FlipX)] | |
| ' If pauseFlag = 0 Then | |
| ' trimmedBitmap.RotateFlip(RotateFlipType.Rotate180FlipX) | |
| PictureBox1.Image = trimmedBitmap | |
| 'xyBitmap.RotateFlip(RotateFlipType.Rotate180FlipX) | |
| PictureBox2.Image = xyBitmap | |
| ' End If | |
| '****g2のクリアを間欠で実施*** | |
| If rn Mod 4 = 0 Then | |
| g2.Clear(Color.Black) | |
| End If | |
| If rn Mod 10 = 0 Then | |
| g3.Clear(Color.Black) | |
| End If | |
| '*********************************** | |
| 'データ番号表示すると遅くなるでコメントアウト | |
| ' Dim fnt As New Font("MS UI Gothic", 12) | |
| 'g2.FillRectangle(Brushes.Black, 0, 0, 100, 50) | |
| 'g2.DrawString("data=" & CStr(rn), fnt, Brushes.Blue, 10, 0) | |
| '解放 | |
| g1.Dispose() | |
| g2.Dispose() | |
| g3.Dispose() | |
| End If | |
| End If | |
| End If | |
| End Sub | |
| Private Sub Button3_Click(sender As Object, e As EventArgs) Handles Button3.Click | |
| If Button3.Text = "Start" Then | |
| Label4.Text = "Paused" | |
| Button3.Text = "Pause" | |
| pauseFlag = 1 | |
| Else | |
| Label4.Text = "Sampling" | |
| Button3.Text = "Start" | |
| pauseFlag = 0 | |
| End If | |
| End Sub | |
| Private Sub DirectPlot(px As Integer, py0 As Integer, py1 As Integer, py2 As Integer) | |
| If PictureBox1.Image Is Nothing Then | |
| PictureBox1.Image = New Bitmap(PictureBox1.Width, PictureBox1.Height) | |
| End If | |
| Dim g0 As Graphics = Graphics.FromImage(PictureBox1.Image) ' sourceBitmapへ書き込むグラフィック処理名g1 | |
| g0.FillEllipse(Brushes.LawnGreen, px, py0, 3, 3) | |
| g0.FillEllipse(Brushes.Red, px, py1, 3, 3) | |
| g0.FillEllipse(Brushes.Yellow, px, py2, 3, 3) | |
| g0.Dispose() | |
| ' PictureBox1.Image = img | |
| PictureBox1.Invalidate() | |
| End Sub | |
| '**************************************BITMAP SAMPLE From STA ************************************************************** | |
| ' '============Rectangleの定義部===================================== | |
| ' Dim srcRect As New Rectangle(PictureBox1.Width * scrollN, sY, cWidth, 600) '切り取り部分定義 | |
| ' Dim desRect As New Rectangle(0, dY, srcRect.Width, srcRect.Height) | |
| ''============================================================= | |
| 'bmap2 = New Bitmap(PictureBox1.Width, PictureBox1.Height) '差し込み用Bitamap bmap2を作成 | |
| 'g2 = Graphics.FromImage(bmap2) 'Graphics g2で描画した結果はbmap2へ書き込まれる宣言 | |
| 'g2.DrawImage(bmap1, desRect, srcRect, GraphicsUnit.Pixel) 'bmap1から指定サイズで切り取ってg2:bmap2へ書き込む | |
| 'g2.Dispose() | |
| '書き込み完了したのでg2は不要'Y軸を１８０度回転させて上下反転して上を北に変更 | |
| 'bmap2.RotateFlip(RotateFlipType.Rotate180FlipX) | |
| ''======PictureBox1へ差し込み実行============ | |
| 'PictureBox1.Image = bmap2 'bmap2を表示 | |
| '***************************************************************************************************** | |
| 'スタートボタン押し | |
| Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click | |
| 'シリアル設定値読み込む | |
| If SerialPort1.IsOpen = False Then | |
| SerialPort1.PortName = ComboBox1.SelectedItem ' "COM18" ' TextBox1.Text 'オープンするポート名を格納 | |
| SerialPort1.BaudRate = CInt(TextBox3.Text) '115200 'baudrate 'baudrate ボーレートを格納 | |
| SerialPort1.Open() 'ポートオープン | |
| Button1.Enabled = False | |
| Button2.Enabled = True | |
| Button3.Enabled = True | |
| If RadioButton1.Checked = True Then | |
| dgv1.Visible = True | |
| PictureBox1.Visible = True | |
| PictureBox2.Visible = False | |
| End If | |
| If RadioButton2.Checked = True Then | |
| dgv1.Visible = True | |
| PictureBox1.Visible = True | |
| PictureBox2.Visible = False | |
| End If | |
| If RadioButton3.Checked = True Then | |
| dgv1.Visible = False | |
| PictureBox1.Visible = True | |
| PictureBox2.Visible = True | |
| End If | |
| rn_start = 1 | |
| 'If dgv1.Rows(0).Cells(3).Value <> " " And dgv1.Rows(0).Cells(5).Value <> " " Then | |
| ' Dim portName As String = "COM" + dgv1.Rows(0).Cells(3).Value 'dgv1からポート番号読み込み | |
| ' SerialPort1.PortName = portName ' portName オープンするポート名を格納 | |
| ' Dim baudrate As String = dgv1.Rows(0).Cells(5).Value 'dgv1からバーレート読み込み | |
| ' SerialPort1.BaudRate = 115200 'baudrate 'baudrate ボーレートを格納 | |
| ' SerialPort1.Open() 'ポートオープン | |
| ' Button1.Enabled = False | |
| ' Button2.Enabled = True | |
| ' rn_start = 1 | |
| 'Else | |
| ' TextBox1.Text = "*******Please Input COM No*******" | |
| 'End If | |
| End If | |
| End Sub | |
| Private Sub Button2_Click(sender As Object, e As EventArgs) Handles Button2.Click | |
| System.Threading.Thread.Sleep(2000) '受信タスク停止するまでdelay1秒いれてからクローズする | |
| SerialPort1.Close() | |
| System.Threading.Thread.Sleep(2000) | |
| Application.Restart() | |
| 'If SerialPort1.IsOpen = True Then 'ポートオープン済み | |
| ' System.Threading.Thread.Sleep(2000) '受信タスク停止するまでdelay1秒いれてからクローズする | |
| ' SerialPort1.Close() | |
| ' dgv1.CurrentCell = dgv1(0, dgv1.Rows.Count - 1) '最下行にカーソルを維持 | |
| ' dgv1.Rows.Clear() | |
| ' rn = 0 | |
| ' dgv1.RowHeadersWidth = 60 | |
| ' dgv1.ColumnCount = 16 | |
| ' dgv1.RowCount = 1 | |
| ' dgv1.Rows.Add("CH1", "CH2", "CH3", "CH4", " CH5", "CH6") | |
| 'End If | |
| 'Button1.Enabled = True | |
| 'Button2.Enabled = False | |
| End Sub | |
| Private Sub SerialPort1_DataReceived(sender As Object, e As SerialDataReceivedEventArgs) Handles SerialPort1.DataReceived | |
| Dim ReceivedData As String = " " '受信データ用変数を宣言します | |
| If CheckBox1.Checked = True And scrollFlag = 0 Then | |
| Try | |
| ReceivedData = SerialPort1.ReadLine 'データを受信します | |
| Catch ex As Exception | |
| ReceivedData = ex.Message '例外処理を行います | |
| End Try | |
| If ReceivedData.Substring(0, 1) = Chr(13) Then | |
| 'SerialPort1.DiscardInBuffer() | |
| 'Invokeメソッドにより実行されるメソッドへのデリゲートの宣言を行い、受信データを表示します | |
| Dim adre As New DataDelegate(AddressOf PrintData) | |
| Me.Invoke(adre, ReceivedData) | |
| End If | |
| End If | |
| End Sub | |
| Private Sub CheckBox1_CheckedChanged(sender As Object, e As EventArgs) Handles CheckBox1.CheckedChanged | |
| If RadioButton1.Checked = True Then | |
| dgv1.Visible = True | |
| PictureBox1.Visible = True | |
| PictureBox2.Visible = False | |
| End If | |
| If RadioButton2.Checked = True Then | |
| dgv1.Visible = True | |
| PictureBox1.Visible = True | |
| PictureBox2.Visible = False | |
| End If | |
| If RadioButton3.Checked = True Then | |
| dgv1.Visible = False | |
| PictureBox1.Visible = True | |
| PictureBox2.Visible = True | |
| End If | |
| If CheckBox1.Checked = True And SerialPort1.IsOpen = True Then | |
| 'TextBox1.Text = "****Sampling****" | |
| rn_start = rn | |
| ElseIf CheckBox1.Checked = False And SerialPort1.IsOpen = True Then | |
| 'TextBox1.Text = "****Paused****" | |
| PictureBox1.Visible = True | |
| dgv1.Visible = True | |
| Dim i As Integer | |
| For i = rn_start To rn | |
| 'Dim cnmastr() As String = dArr.Split(vbCrLf) | |
| 'If cnmastr.Length > 1 Then | |
| Dim arr1() As String = dArr(i).Split(",") | |
| ' TextBox1.Text = i.ToString | |
| dgv1.Rows.Add(arr1) | |
| dgv1.Rows(i).HeaderCell.Value = i.ToString() '行ヘッダーにデータ番号rn | |
| dgv1.FirstDisplayedScrollingRowIndex = dgv1.Rows.Count - 1 '最新データの最下行を表示 | |
| 'End If | |
| Next | |
| End If | |
| End Sub | |
| Private Sub dgv1_MouseClick(sender As Object, e As MouseEventArgs) Handles dgv1.MouseClick | |
| If dgv1.CurrentCell.RowIndex = 0 And dgv1.CurrentCell.ColumnIndex = 3 Then | |
| ' TextBox1.Text = "" | |
| End If | |
| End Sub | |
| 'Averaging Cursor | |
| Private Sub Button4_Click(sender As Object, e As EventArgs) Handles Button4.Click | |
| Dim Vnum As Integer = vRx - vLx | |
| Dim i As Integer | |
| Dim vSum1 As Double = 0 | |
| Dim vSum2 As Double = 0 | |
| Dim vSum3 As Double = 0 | |
| Dim vAve1, vAve2, vAve3 As Double | |
| For i = vLx To vRx - 1 | |
| vSum1 = vSum1 + data1(i) | |
| vSum2 = vSum2 + data2(i) | |
| vSum3 = vSum3 + data3(i) | |
| Next i | |
| vAve1 = vSum1 / Vnum | |
| vAve2 = vSum2 / Vnum | |
| vAve3 = vSum3 / Vnum | |
| dgv1.Rows.Add(vAve1, vAve2, vAve3, vLx, vRx) | |
| End Sub | |
| Private Sub Form1_MouseClick(sender As Object, e As MouseEventArgs) Handles Me.MouseClick | |
| 'カーソル書き込み用のBitmapをlongBitmapからセッション毎に作成 | |
| If RadioButton2.Checked = True Then | |
| cursorBitmap = New Bitmap(longBitmap) | |
| clickN += 1 | |
| 'Dim cursorBitmap As New Bitmap(longBitmap) 'Cursor用BitmapをlongBitmapをコピーして作成 | |
| 'Graphic 定義 | |
| 'Dim g0 As Graphics = Graphics.FromImage(longBitmap) ' longBitmapへ書き込むグラフィック処理名g1 | |
| ' Dim g1 As Graphics = Graphics.FromImage(sourceBitmap) ' sourceBitmapへ書き込むグラフィック処理名g1 | |
| ' Dim g2 As Graphics = Graphics.FromImage(trimmedBitmap) 'trimmedBitmapへ書き込むグラフィック処理名g2 | |
| Dim g4 As Graphics = Graphics.FromImage(cursorBitmap) 'cursorBitmapへ書き込むグラフィック処理名g3 | |
| Dim g5 As Graphics = Graphics.FromImage(ctrimBitmap) ' ctrimBitmapへ書き込むグラフィック処理名g5 | |
| 'フォーム上の座標でマウスポインタの位置を取得する | |
| '画面座標でマウスポインタの位置を取得する | |
| Dim sp As System.Drawing.Point = System.Windows.Forms.Cursor.Position | |
| '画面座標をクライアント座標に変換する | |
| Dim cp As System.Drawing.Point = Me.PointToClient(sp) | |
| 'X座標を取得する | |
| Dim x As Integer = cp.X | |
| 'Y座標を取得する | |
| Dim y As Integer = cp.Y | |
| 'TextBox2.Text = CStr(cp.X) + "," + CStr(cp.Y) | |
| If e.Button = MouseButtons.Right Then | |
| cRflag += 1 | |
| cRx_1 = cRx | |
| cRx = cp.X - PictureBox1.Left | |
| 'カーソルX座標からY座標値表示 | |
| cRlongX = cRx + startX | |
| vRx = cRx * xScale + longX | |
| Label5.Text = "Right:X[" + CStr(vRx) + "]Y[" + data1(vRx).ToString("0.00") + "/" + data2(vRx).ToString("0.00") + "/" + data3(vRx).ToString("0.00" + "]") | |
| 'Debug.Print("clickN=" & CStr(clickN) & ":cRx,cp.X,startX,PictureBox.Left=" & CStr(cRx) & "," & CStr(cp.X) & "," & CStr(startX) & "," & CStr(PictureBox1.Left)) | |
| End If | |
| If e.Button = MouseButtons.Left Then | |
| cLflag += 1 | |
| cLx_1 = cLx | |
| cLx = cp.X - PictureBox1.Left | |
| 'カーソルX座標からY座標値表示 | |
| cLlongX = cLx + longX | |
| vLx = cLx * xScale + longX | |
| Label6.Text = "Left:X[" + CStr(vLx) + "]Y[" + data1(vLx).ToString("0.00") + "/" + data2(vLx).ToString("0.00") + "/" + data3(vLx).ToString("0.00" + "]") | |
| End If | |
| Label7.Text = "Mouse_longX=" & CStr(longX) & ",startX=" & CStr(startX) | |
| 'cursorBitmap = New Bitmap(longBitmap) | |
| ' If vRx > longX And vRx < longX + PictureBox1.Width Then | |
| Dim sweight As Integer | |
| Select Case xScale | |
| Case 1 | |
| sweight = 2 | |
| Case 2, 3, 4, 5 | |
| sweight = 6 | |
| Case 6, 7, 8, 9, 10 | |
| sweight = 10 | |
| End Select | |
| Dim pG3 As New Pen(Color.LawnGreen, sweight) | |
| Dim pW3 As New Pen(Color.White, sweight) | |
| g4.DrawLine(pG3, vRx, 0, vRx, PictureBox1.Height) | |
| ' End If | |
| 'If vLx > longX And vRx < longX + PictureBox1.Width Then | |
| g4.DrawLine(pW3, vLx, 0, vLx, PictureBox1.Height) | |
| ' End If | |
| '切取り四角の定義 | |
| ' If rn > 800 * xScale Then | |
| Dim srcRect As New Rectangle(longX, 0, 800 * xScale, 400) 'ソースから切り取る四角の定義 | |
| Dim desRect As New Rectangle(0, 0, 800, 400) '切り取った四角を貼りこむ四角の定義=>今回はソースと同じサイズなので等倍コピー | |
| 'ctrimBitmapへ切取り書き込み | |
| g5.Clear(Color.Black) | |
| g5.DrawImage(cursorBitmap, desRect, srcRect, GraphicsUnit.Pixel) | |
| ' ctrimBitmap.RotateFlip(RotateFlipType.Rotate180FlipX) | |
| PictureBox1.Image = ctrimBitmap | |
| g4.Dispose() | |
| g5.Dispose() | |
| ' End If | |
| 'PictureBox1.Invalidate() | |
| Else | |
| End If | |
| End Sub | |
| 'Private Sub delCursor(ByVal cRx As Integer, ByVal dw As Integer) | |
| ' Dim g0 As Graphics = Graphics.FromImage(longBitmap) ' longBitmapへ書き込むグラフィック処理名g0 | |
| ' Dim g4 As Graphics = Graphics.FromImage(cursorBitmap) ' cursorBitmapへ書き込むグラフィック処理名g4 | |
| ' Dim g5 As Graphics = Graphics.FromImage(ctrimBitmap) ' ctrimBitmapへ書き込むグラフィック処理名g5 | |
| ' Dim srcRect As New Rectangle(cRx + startX - dw, 0, dw * 2, 400) 'ソースから切り取る四角の定義 | |
| ' Dim desRect As New Rectangle(cRx + startX - dw, 0, dw * 2, 400) '切り取った四角を貼りこむ四角の定義=>今回はソースと同じサイズなので等倍コピー | |
| ' '【カーソルを消去するために、longBitmapからカーソル線近傍を切り取ってcursorBitmapへg4で上書きする】 | |
| ' g4.DrawImage(longBitmap, desRect, srcRect, GraphicsUnit.Pixel) ' | |
| ' '【g４処理結果をctrimBitmapに書き込む、srcRectでcursorBitmapから切り取ってdesRectでctrimBitmapへｇ５で書き込む】 | |
| ' srcRect = New Rectangle(startX, 0, 800, 400) 'ソースから切り取る四角の定義 | |
| ' desRect = New Rectangle(0, 0, 800, 400) '切り取った四角を貼りこむ四角の定義=>今回はソースと同じサイズなので等倍コピー | |
| ' g5.DrawImage(cursorBitmap, desRect, srcRect, GraphicsUnit.Pixel) ' | |
| ' ' PictureBox1.Image = ctrimBitmap | |
| ' g4.Dispose() | |
| ' g5.Dispose() | |
| ' g0.Dispose() | |
| 'End Sub | |
| End Class | |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment