Created
November 20, 2021 03:05
-
-
Save dj1711572002/f2f34047fc4d545a4c5c9bcf808aa6a4 to your computer and use it in GitHub Desktop.
VB.NET RealTimeGraph ver2 Bitmap Copy Cursor and Graph Scrolling
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 | |
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 As Integer | |
Dim fz As Integer | |
Dim momx As Integer | |
Dim momy As Integer | |
Dim py0, py0_1 As Integer | |
Dim py1, py1_1 As Integer | |
Dim py2, py2_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 | |
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 | |
HScrollBar1.Visible = True | |
Label7.Text = "Hscrollhx_longX=" & CStr(longX) & "startX=" & CStr(startX) | |
Dim srcRect As New Rectangle(hx - 800, 0, 800 * xScale, 400) 'ソースから切り取る四角の定義 | |
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 | |
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 = False | |
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 | |
'重心計算用電圧生データ保持 | |
Dim py00 As Double = Int((arr1(0) - ave0) * 100) / 100 | |
Dim py01 As Double = Int((arr1(1) - ave1) * 100) / 100 | |
Dim py02 As Double = Int((arr1(2) - ave2) * 100) / 100 | |
'=======グラフ描画============================================================================================== | |
px = Int(rn / xScale) '時間軸調整 | |
px = px Mod 1600 'sourceBitmap 幅で折り返し | |
px0 = rn Mod 60000 | |
If rn > 200 Then | |
'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("py=" & 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でプロット----------------------------------------------------------------------------- | |
If px > 0 Then | |
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 | |
If px > 0 Then | |
g0.DrawLine(Pens.Blue, px0, pH - py0, px0 - 1, pH - py0_1) | |
g0.DrawLine(Pens.Red, px0, pH - py1, px0 - 1, pH - py1_1) | |
g0.DrawLine(Pens.LawnGreen, px0, pH - py2, px0 - 1, pH - py2_1) | |
End If | |
'---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 | |
'xyBitmap 座標軸プロット | |
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) | |
'xyBitmapの座標 | |
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軸を180度回転させて上下反転して上を北に変更 | |
'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 = False | |
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 = False | |
PictureBox1.Visible = True | |
PictureBox2.Visible = False | |
End If | |
If RadioButton2.Checked = True Then | |
dgv1.Visible = True | |
PictureBox1.Visible = False | |
PictureBox2.Visible = False | |
End If | |
If RadioButton3.Checked = True Then | |
dgv1.Visible = True | |
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 = False | |
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 | |
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 pG3 As New Pen(Color.LawnGreen, 6) | |
Dim pW3 As New Pen(Color.White, 6) | |
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) ' | |
' '【g4処理結果をctrimBitmapに書き込む、srcRectでcursorBitmapから切り取ってdesRectでctrimBitmapへg5で書き込む】 | |
' 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