Skip to content

Instantly share code, notes, and snippets.

@dj1711572002

dj1711572002/SKI_NAV-PVT_RELPOSNED_SkiPictures_rev016.vb

Created March 5, 2021 21:43
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/3189d7bf0c65e456a955c02132de28ff to your computer and use it in GitHub Desktop.
Save dj1711572002/3189d7bf0c65e456a955c02132de28ff to your computer and use it in GitHub Desktop.
Download ZIP
VB.net RTK-Analyzer RTK-SKI-MotionData vs MP4 Frame Picture Asynchronized
Raw
SKI_NAV-PVT_RELPOSNED_SkiPictures_rev016.vb
'Serial Port Recieve Sample Program
'Form1 Object must create ,button1,2 & textbox 1,2　
Imports System.Drawing.Image.FromFile
Imports System.IO.Ports
Imports Microsoft.VisualBasic.FileIO
Imports System.IO
Imports System.Text
Imports System.Collections
Public Class Form1
'Dim bdat As Byte()
Public dataReceivedFlag As Integer
Dim sdat As String()
Dim i, j, k, l As Integer
Dim NN As Integer
Dim NVC As Integer = 0 'NAV data Counter
Dim NVi As Integer = 0
Dim PVTflag As Integer = 0
Dim RELPflag As Integer = 0
Dim startIndex As Integer
Dim strPVT As String
Dim sbPVT As String()
Dim bPVT As Byte()
Dim strRELP As String
Dim sbRELP As String()
Dim bRELP As Byte()
Dim sw As New System.Diagnostics.Stopwatch()
'================PVT RELP Paramers============================
Dim parPVT As Long()
Dim parRELP As Long()
Public headPVT As String
Public headPVTArry As String()
Public headRELP As String
Public headRELPArry As String()
Public dgArry(,) As Long
'=============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
'------file para------------
Public cindex As Integer
Public dreadata(60000, 700) As String
Public dcIndex As Integer
Public dcIndex_max As Integer
Public rdataN As Integer
Public fopen As Integer
Public f1open As Integer
Public fnameH As String
Public fStr1, fstr2 As String
Public dataSu2 As Integer
'---plotC parameters------------
Public pcount As Integer
Public clearFlag As Integer
Public xsize As Integer ' = 1200
Public ysize As Integer ' = 400
Public axisdiv As Integer 'divsize
Public startrowN As Integer
Public plotrowN As Integer
Public zLon, zLat, zHeight As Integer '緯度経度高度plot 中心基準点
Public zLon_1, zLat_1, zHeight_1 As Integer 'Scrollbarの開始時の基準点
Public zRelN, zRelE, zRelD As Integer 'RELPOSNED 基準点
Public zsetFlag As Integer
Public SecondFlag As Integer
Public col_lon, col_lati, col_height, col_N, col_E, col_D, col_Len As Integer 'dgv columns select
Public col2_lon, col2_lati, col2_height, col2_N, col2_E, col2_D, col2_Len As Integer 'dgv columns select
Public pxb, pyb, pxr, pyr As Integer
Public pxb_1, pyb_1, pxr_1, pyr_1 As Integer
'-----Ring Buffer----------------
Public sd1, sd2, sd3 As String
Public setN As Integer 'UART Received Data char Number
Public idx As Integer
'----rePlay Mode-----------------
Public lonArry As Integer()
Public latiArry As Integer()
Public heightArry As Integer()
Public lonrArry As Integer()
Public latirArry As Integer()
Public heightrArry As Integer()
Public relNArry As Single()
Public relEArry As Single()
Public relDarry As Single()
Public Maxlon, Minlon, Maxlati, Minlati, Maxheight, Minheight As Long
Public Maxrlon, Minrlon, Maxrlati, Minrlati, Maxrheight, Minrheight As Long
Public Avelon, Avelati, Aveheight As Long
Public Ascale As Single
Public AlonOff, AlatiOff As Long
Public lonratio As Single
Public latiratio As Single
Public rScale As Single
Public dumLon, dumLati, dumN, dumE, dumD As Integer
Public rSize As Integer
Public Npbx, Npby, Nprx, Npry As Integer()
Public mouseFlag As Integer
Public stepFlag As Integer
Public mClick As Integer
Public offX, offY As Integer 'hScrollbar vScrollbar adjust dot value
Public moffX, moffY As Integer 'Mouse Point center Offset
Public sx, sy, ex, ey As Integer 'Mouse Pointer Rectangle
'-----rePlay2 mode hscrllbar4control-----------------
Public stN, enN As Integer
Public enN_1 As Integer
Public Kbold, Kbold_1 As Integer
Public komaFlag, komaFlag_1 As Integer
Public delFlag, delFlag_1 As Integer 'bold Line fill Black
'-------Analytics para-----------------------
Public RBset As Integer 'checkbox13=true =-1 minus False=1
'Text dipslay timer
Public rN0, hour0, min0, sec0, msec0 As Integer
Public monthN, dayN, hourN, minN, secN, itowN, msecN As Integer
'-----------Vector Meter------------------------------
Public ANlon1, ANlat1, ANheight1, ANrelN1, ANrelE1, ANrelD1 As Integer
Public ANlon1_1, ANlat1_1, ANheight1_1, ANrelN1_1, ANrelE1_1, ANrelD1_1 As Integer
Public ANlon1_2, ANlat1_2, ANheight1_2, ANrelN1_2, ANrelE1_2, ANrelD1_2 As Integer
Public ANlon2, ANlat2, ANheight2, ANrelN2, ANrelE2, ANrelD2 As Integer
Public ANlon2_1, ANlat2_1, ANheight2_1, ANrelN2_1, ANrelE2_1, ANrelD2_1 As Integer
Public ANlon2_2, ANlat2_2, ANheight2_2, ANrelN2_2, ANrelE2_2, ANrelD2_2 As Integer
'---
Public Axb1, Ayb1, Axr1, Ayr1, Axb2, Ayb2, Axr2, Ayr2 As Integer
Public Axb1_1, Ayb1_1, Axr1_1, Ayr1_1, Axb2_1, Ayb2_1, Axr2_1, Ayr2_1 As Integer
Public Axb1_2, Ayb1_2, Axr1_2, Ayr1_2, Axb2_2, Ayb2_2, Axr2_2, Ayr2_2 As Integer
Public Apx0, Apy0 As Integer
Public Apx0_1, Apy0_1 As Integer
Public Apx0_2, Apy0_2 As Integer
Public speedL, headL, skiL, slipL As Double
'-------------------Pictures Parameter-----------------------------------------------------------
'画像ファイルを読み込む
Private images As Image() = New Image() {}
Public koma0 As Integer 'グラフと同期させたコマファイル番号
Public picN As Integer 'コマファイル番号
Public Hsc4 As Integer 'HscrollBar4を動かしているときのみコマ送りする
'Picturebox2シリーズ
Private currentImage As Bitmap
'倍率
Private zoomRatio As Double
'倍率変更後の画像のサイズと位置
Private drawRectangle As Rectangle
'------------------------------------------------------------------------------------------------
'Asynchronized OK----------------------------------------------------------------------------------------
Private Sub CheckBox16_CheckedChanged(sender As Object, e As EventArgs) Handles CheckBox16.CheckedChanged
If CheckBox16.Checked = True Then
koma0 = picN
End If
End Sub
'=========================KomaOkuri SUB=======================================
Private Sub koma(ByVal n As Integer)
Dim images(2000)
Dim fstr As String = "C:\SkiPic\210301_1323_DT\Produce_" '01.jpg"
Dim fnstr As String
fnstr = (n).ToString("D4") + ".png"
fstr = fstr + fnstr
Label31.Text = fstr
images(i) = Image.FromFile(fstr)
'images(1) = Image.FromFile("C:\SkiPic\Produce_401.jpg")
currentImage = images(i)
' Panel1.Invalidate()
'倍率変更後の画像のサイズと位置を計算する
drawRectangle.Width = 640 'CInt(Math.Round(currentImage.Width * zoomRatio))
drawRectangle.Height = 360 'CInt(Math.Round(currentImage.Height * zoomRatio))
drawRectangle.X = 0 'CInt(Math.Round(pb.Width / 2.0 - imgPoint.X * zoomRatio))
drawRectangle.Y = 0 'CInt(Math.Round(pb.Height / 2.0 - imgPoint.Y * zoomRatio))
' Label33.Text = "dR.Width=" + CStr(drawRectangle.Width) + "dR.Heght=" + CStr(drawRectangle.Height) + "dR.X=" + CStr(drawRectangle.X) + "dR.Y=" + CStr(drawRectangle.Y)
'画像を表示する
PictureBox2.Invalidate()
Label33.Text = "komaN=" + CStr(n) + "koma0=" + CStr(koma0) + "komaN-koma0=" + CStr(n - koma0)
End Sub
'トラックバーでコマ送り
Private Sub TrackBar1_Scroll(sender As Object, e As EventArgs) Handles TrackBar1.Scroll
If CheckBox16.Checked = False Then 'チェックボックス１６がチェックされてないときに自由に動かせる
zoomRatio = 0.5
picN = TrackBar1.Value
' picN = Val(Label32.Text) + 1
Label32.Text = CStr(picN)
koma(picN)
End If
'picN += 1
'Dim fstr As String = "C:\SkiPic\210301_1323_DT\Produce_" '01.jpg"
'Dim fnstr As String
'fnstr = (picN).ToString("D4") + ".png"
'fstr = fstr + fnstr
'Label31.Text = fstr
'images(i) = Image.FromFile(fstr)
''images(1) = Image.FromFile("C:\SkiPic\Produce_401.jpg")
'currentImage = images(i)
'' Panel1.Invalidate()
''倍率変更後の画像のサイズと位置を計算する
'drawRectangle.Width = 640 'CInt(Math.Round(currentImage.Width * zoomRatio))
'drawRectangle.Height = 360 'CInt(Math.Round(currentImage.Height * zoomRatio))
'drawRectangle.X = 0 'CInt(Math.Round(pb.Width / 2.0 - imgPoint.X * zoomRatio))
'drawRectangle.Y = 0 'CInt(Math.Round(pb.Height / 2.0 - imgPoint.Y * zoomRatio))
'Label33.Text = "dR.Width=" + CStr(drawRectangle.Width) + "dR.Heght=" + CStr(drawRectangle.Height) + "dR.X=" + CStr(drawRectangle.X) + "dR.Y=" + CStr(drawRectangle.Y)
''画像を表示する
'PictureBox2.Invalidate()
End Sub
'Panel1に画像表示
Private Sub Button14_Click(sender As Object, e As EventArgs) Handles Button14.Click
Dim images(100)
zoomRatio = 0.5
picN = Val(Label32.Text) + 1
Label32.Text = CStr(picN)
'picN += 1
Dim fstr As String = "C:\SkiPic\210301_1323_DT\Produce_" '01.jpg"
Dim fnstr As String
fnstr = (picN).ToString("D4") + ".png"
fstr = fstr + fnstr
Label31.Text = fstr
images(i) = Image.FromFile(fstr)
'images(1) = Image.FromFile("C:\SkiPic\Produce_401.jpg")
currentImage = images(i)
' Panel1.Invalidate()
'倍率変更後の画像のサイズと位置を計算する
drawRectangle.Width = 640 'CInt(Math.Round(currentImage.Width * zoomRatio))
drawRectangle.Height = 360 'CInt(Math.Round(currentImage.Height * zoomRatio))
drawRectangle.X = 0 'CInt(Math.Round(pb.Width / 2.0 - imgPoint.X * zoomRatio))
drawRectangle.Y = 0 'CInt(Math.Round(pb.Height / 2.0 - imgPoint.Y * zoomRatio))
Label33.Text = "dR.Width=" + CStr(drawRectangle.Width) + "dR.Heght=" + CStr(drawRectangle.Height) + "dR.X=" + CStr(drawRectangle.X) + "dR.Y=" + CStr(drawRectangle.Y)
'画像を表示する
PictureBox2.Invalidate()
End Sub
'PictureBox1のMouseDownイベントハンドラ
'Private Sub PictureBox2_MouseDown(sender As Object, e As MouseEventArgs) _
' Handles PictureBox2.MouseDown
' Dim pb As PictureBox = DirectCast(sender, PictureBox)
' 'クリックされた位置を画像上の位置に変換
' ' Label33.Text = "MouseClick X=" + CStr(e.X) + "Y=" + CStr(e.Y)
' Dim imgPoint As New Point(CInt(Math.Round((e.X - drawRectangle.X) / zoomRatio)),
' CInt(Math.Round((e.Y - drawRectangle.Y) / zoomRatio)))
' '倍率を変更する
' 'zoomRatio = 1
' 'If e.Button = MouseButtons.Left Then
' ' zoomRatio *= 0.5
' 'ElseIf e.Button = MouseButtons.Right Then
' ' zoomRatio *= 0.3
' 'End If
' '倍率変更後の画像のサイズと位置を計算する
' drawRectangle.Width = 640 'CInt(Math.Round(currentImage.Width * zoomRatio))
' drawRectangle.Height = 360 'CInt(Math.Round(currentImage.Height * zoomRatio))
' drawRectangle.X = 0 'CInt(Math.Round(pb.Width / 2.0 - imgPoint.X * zoomRatio))
' drawRectangle.Y = 0 'CInt(Math.Round(pb.Height / 2.0 - imgPoint.Y * zoomRatio))
' Label33.Text = "dR.Width=" + CStr(drawRectangle.Width) + "dR.Heght=" + CStr(drawRectangle.Height) + "dR.X=" + CStr(drawRectangle.X) + "dR.Y=" + CStr(drawRectangle.Y)
' '画像を表示する
' PictureBox2.Invalidate()
'End Sub
'PictureBox1のPaintイベントハンドラ
Private Sub PictureBox2_Paint(sender As Object, e As PaintEventArgs) _
Handles PictureBox2.Paint
If Not (currentImage Is Nothing) Then
'画像を指定された位置、サイズで描画する
e.Graphics.DrawImage(currentImage, drawRectangle)
End If
End Sub
'=============================START PROGRM=================================================================================================
Delegate Sub DataDelegate(ByVal sdata As String)
'==========================================================================================================================================
'PrintData データ受信コア==========================================================================================
'===================================================================================================================
Private Sub PrintData(ByVal sdata As String)
'Debug.Print("****************Inputted_sdata.length-" & CStr(sdata.Length) & "-Result_sdata-" & sdata)
' dgv1.ColumnCount = 200 'str_sdata.Length
If sdata.Length = 0 Then
Exit Sub
ElseIf sdata.Length > 0 And CheckBox5.Checked = True Then
idx = idx + 1
'RichTextBox1.AppendText(sdata + vbCrLf)
Exit Sub
End If
'ASCII data ESP-NOW処理部---------------------------------------------------
If RadioButton3.Checked = True And sdata.Length > 400 And sdata.Length < 517 Then '172x3=516
'sdata SPLIT CHECK
Dim split_sdata As String() = sdata.Split(",")
If split_sdata.Length > 172 Then
'Debug.Print(CStr(NVC) & "-ASCII:split_sdata Len-" & CStr(split_sdata.Length))
Exit Sub
End If
'PVT to binStr
' Debug.Print("ASCII:sdataLen=" & sdata.Length & ":" & sdata)
Dim startRELP As Integer = sdata.IndexOf("B5,62,1,3C")
strPVT = sdata.Substring(0, startRELP - 1)
sbPVT = strPVT.Split(",")
PVTflag = 1
strRELP = sdata.Substring(startRELP, sdata.Length - startRELP - 1)
sbRELP = strRELP.Split(",")
RELPflag = 1
End If
k = k + 1
'BlueTooth Binary172byte処理部-----------------------------------------------
' Dim setN As Integer = 515 '受信データセット文字数 172バイト*3（文字）-1（最後尾無し）
If RadioButton1.Checked = True And CheckBox5.Checked = False Then
setN = 515
Dim slen As Integer = sdata.Length
' Debug.Print("Org_sdata.length-" & CStr(sdata.Length) & "-Result_sdata-" & sdata)
' Debug.Print("Org_sd2.length-" & CStr(sd2.Length) & "-Result_sd2-" & sd2)
If sd2 = "" Then
Else
sdata = sd2 + "-" + sdata
End If
'Debug.Print("Add_sdata.length-" & CStr(sdata.Length) & "-Result_sdata-" & sdata)
If sdata.Length < setN Then
sd2 = sdata
'Debug.Print("short_sd1=" & sd1)
Exit Sub
ElseIf sdata.Length > setN Then
sd1 = sdata.Substring(0, setN) '[0]-[setN-1] setN個
'sd2 = sdata.Substring(setN, sdata.Length - 1 - setN) '[setN]-[sdata.Length-1]
If sdata.Length = setN Then
sd2 = ""
Else
sd2 = sdata.Replace(sd1, "")
End If
'Debug.Print("Replaced_sd2.length-" & CStr(sd2.Length) & "-Replaced_sd2-" & sd2)
If sd2.Substring(0, 1) = "-" Then
sd2 = sd2.Substring(1, sd2.Length - 1)
End If
'Debug.Print("Pre_sd1.length-" & CStr(sd1.Length) & "-Pre_sd1-" & sd1)
'Debug.Print("Pre_sd2.length-" & CStr(sd2.Length) & "-Pre_sd2-" & sd2)
Dim topN As Integer = sd1.IndexOf("B5-62-01-07")
Dim topStr As String = sd1.Substring(topN, sd1.Length - topN)
Dim lastStr As String
If topN = 0 Then
sd3 = topStr
Else
lastStr = sd1.Substring(0, topN - 1)
sd3 = topStr + "-" + lastStr
End If
ElseIf sdata.Length = setN Then
sd3 = sdata
'Debug.Print("Just515Result_sd3.length-" & CStr(sd3.Length) & "-Result_sd3-" & sd3)
End If
'Debug.Print("Rcv_K=" & CStr(k) & "sdata_Sort_time=" & sw.ElapsedMilliseconds)
' If CheckBox4.Checked = True Then
'RichTextBox1.AppendText("Rcv_K=" & CStr(k) & "=sdata_Sort_time=" & sw.ElapsedMilliseconds & vbCrLf)
'End If
sw.Reset()
sw.Start()
'Debug.Print("Result_sd1.length-" & CStr(sd1.Length) & "-Result_sd1-" & sd1)
'Debug.Print("Result_sd2.length-" & CStr(sd2.Length) & "-REsult_sd2-" & sd2)
'Debug.Print("Result_sd3.length-" & CStr(sd3.Length) & "-Result_sd3-" & sd3)
'PVT to binStr
strPVT = sd3.Substring(0, 299)
sbPVT = strPVT.Split("-")
PVTflag = 1
strRELP = sd3.Substring(300, 215)
sbRELP = strRELP.Split("-")
RELPflag = 1
End If 'BT 172byte
' USB Serial Binary268byte 処理部 ------------------------------------------------------
If RadioButton2.Checked = True And CheckBox5.Checked = False And RadioButton3.Checked = False Then
startIndex = sdata.IndexOf("B5-62-01-07")
'Debug.Print("slen1=" & CStr(sdata.Length) & "sdata(" & CStr(k) & ")=" & sdata)
'Debug.Print("PVT:stratIndex=" & CStr(startIndex))
'If startIndex < 0 Then
'Exit Sub
'End If
'Debug.Print("sdata_len=" & CStr(sdata.Length) & "sdata(" & CStr(k) & ")=" & sdata)
'Debug.Print("PVT_stratIndex=" & CStr(startIndex))
If startIndex >= 0 And sdata.Length >= 299 And startIndex < sdata.Length - 200 Then
sw.Stop()
'Debug.Print("PVT_time=" & sw.ElapsedMilliseconds)
sw.Start()
strPVT = sdata.Substring(startIndex, 299) 'PVT 100bytex3=300 最後のデリミタが無いから299
sbPVT = strPVT.Split("-")
'Debug.Print("PVT:start=" & CStr(startIndex) & "PVT_len=" & CStr(sdata.Length) & "strPVT=" & strPVT)
PVTflag = 1
End If
startIndex = sdata.IndexOf("B5-62-01-3C")
'Debug.Print("slen2=" & CStr(sdata.Length) & "sd3(" & CStr(k) & ")=" & sdata)
' Debug.Print("RELP:stratIndex=" & CStr(startIndex))
If startIndex >= 0 And sdata.Length >= 215 And startIndex < sdata.Length - 144 Then
' Debug.Print("RELP_startIndex=" & CStr(startIndex))
sw.Stop()
' Debug.Print("RELPOSNED_time=" & sw.ElapsedMilliseconds)
sw.Start()
strRELP = sdata.Substring(startIndex, 215) ' RELPOSNED 72bytex3=216 最後のデリミタが無いから215
sbRELP = strRELP.Split("-")
'Debug.Print("RELPOSNED:start=" & CStr(startIndex) & "relP_len=" & CStr(sdata.Length) & "strRELP=" & strRELP)
RELPflag = 1
End If
End If
'FIle read データ再生処理部-------------------------------------------------------------------------
'MBログファイルからｄｇｖ用に変換して読み込む
'============================================================================================
If PVTflag = 1 And RELPflag = 1 And CheckBox5.Checked = False Then
NVC += 1 'NAV data set Counter
' Debug.Print("NVC=" & CStr(NVC))
'--------PVTとRELPOSNED16進数string配列を2次元Byte配列に変換--------------------------------------------
For i = 0 To 99
bPVT(i) = Convert.ToByte(sbPVT(i), 16)
'Debug.Print("bPVT(" & CStr(NVC) & "," & CStr(i) & ")=" & CStr(bPVT( i)) & ":" & sbPVT(i))
Next
For i = 0 To 71
bRELP(i) = Convert.ToByte(sbRELP(i), 16)
' Debug.Print("bRELP(" & CStr(NVC) & "," & CStr(i) & ")=" & CStr(bRELP( i)) & ":" & sbRELP(i))
Next
'DGVデータ表示=================
Dim rowN As Integer
rowN = (NVC - 1) 'Data Printing 繰り返し行指定
'----------------変換　SUB-----------------------------------------------
PVT_Trans(NVC) ' PVT Binary を実数データに変換　parPVT(1-33) as integer
RELP_Trans(NVC) ' RELPOSNED Binary を実数データに変換　parRELP(1-15) as integer
'--------------ファイルWrite parPVTとparRELP dgv表示ではなく全データ保存----------------------------------------------------
If fopen = 1 Then
Label2.Text = "-Logging-"
Dim fStr As String
fStr = CStr(NVC)
For i = 1 To 33 'parPVT(1-33) to fStr
fStr = fStr + "," + CStr(parPVT(i))
Next
For i = 1 To 15 'parRELP(1-15) to fStr
fStr = fStr + "," + CStr(parRELP(i))
Next
fStr = fStr + vbCrLf
file.Write(fStr)
End If
'-------------DGV1 サイズ決め-------------------------------
dgv1.ColumnCount = 23
'----Rows(0)=time sec
dgv1.Columns(0).HeaderText = "Sec"
dgv1.Columns(0).Width = 40
Dim tSec As Single = NVC * 0.125 ' Sampling time sec
'--PVTヘッダー
dgv1.Columns(1).HeaderText = "iTow"
Dim iTow As Integer = parPVT(1)
dgv1.Columns(1).Width = 60
dgv1.Columns(2).HeaderText = "fixType"
Dim fixType As Integer = parPVT(11)
dgv1.Columns(3).HeaderText = "numSV"
Dim numSV As Integer = parPVT(14)
dgv1.Columns(4).HeaderText = "lon"
Dim lon As Integer = parPVT(15)
dgv1.Columns(5).HeaderText = "lat"
Dim lat As Integer = parPVT(16)
dgv1.Columns(6).HeaderText = "height"
Dim height As Integer = parPVT(17)
dgv1.Columns(7).HeaderText = "hAcc"
Dim hAcc As Integer = parPVT(19)
dgv1.Columns(8).HeaderText = "vAcc"
Dim vAcc As Integer = parPVT(20)
dgv1.Columns(9).HeaderText = "velN"
Dim velN As Integer = parPVT(21)
dgv1.Columns(10).HeaderText = "velE"
Dim velE As Integer = parPVT(22)
dgv1.Columns(11).HeaderText = "velD"
Dim velD As Integer = parPVT(23)
'--RELPOSNED ヘッダー
dgv1.Columns(12).HeaderText = "RELP_iTow"
Dim RELP_iTOW As Integer = parRELP(1)
dgv1.Columns(13).HeaderText = "relPosN"
Dim relPosN As Single = parRELP(2) + parRELP(7) * 0.1
dgv1.Columns(14).HeaderText = "relPosE"
Dim relPosE As Single = parRELP(3) + parRELP(8) * 0.1
dgv1.Columns(15).HeaderText = "relPosD"
Dim relPosD As Single = parRELP(4) + parRELP(9) * 0.1
dgv1.Columns(16).HeaderText = "relPosLength"
Dim relPosLength As Single = parRELP(5) + parRELP(10) * 0.1
dgv1.Columns(17).HeaderText = "relPosHeading"
Dim relPosHeading As Single = parRELP(6) * 0.00001
dgv1.Columns(18).HeaderText = "accN"
Dim accN As Single = parRELP(11) * 0.01
dgv1.Columns(19).HeaderText = "accE"
Dim accE As Single = parRELP(12) * 0.01
dgv1.Columns(20).HeaderText = "accD"
Dim accD As Single = parRELP(13) * 0.01
dgv1.Columns(21).HeaderText = "accLength"
Dim accLength As Single = parRELP(14) * 0.01
dgv1.Columns(22).HeaderText = "accHeading"
Dim accHeading As Single = parRELP(15) * 0.00001
'===================行追加と一括書き込み===============================
'PVT=1:iTow,11:fixType,14:numSV,15:lon,16:lat,17:height,19:hAcc ,20:vAcc,21:velN,22:velE,23:velD
'RELPOSNED=1:iTOW,2:relPosN,3:relPosE,4:relPosD,5:relPosLength,6:relPosHeading,
'11:accN,12:accE,13:accD,14:accLength,15:accHeading
dgv1.Rows.Add(tSec, iTow, fixType, numSV, lon, lat, height, hAcc, vAcc, velN, velE, velD,
RELP_iTOW, relPosN, relPosE, relPosD, relPosLength, relPosHeading,
accN, accE, accD, accLength, accHeading)
'------------dgv1 行ヘッダー番号　--------------------------------
dgv1.Rows(rowN).HeaderCell.Value = NVC.ToString() '行ヘッダーにデータ番号NVC
dgv1.RowHeadersWidth = 60
'-----Focus Row------------------------------------
If rowN > 5 Then
dgv1.FirstDisplayedScrollingRowIndex = rowN
End If
PVTflag = 0
RELPflag = 0
'================================================================================================================================================
'================================================================================================================================================
'plotC 　グラフィック描画=======================================================================================================================
'================================================================================================================================================
'================================================================================================================================================
'------wait 時間制御 NVCカウントする hscrollbar1でwait時間調整
' waitN=0停止で手動プロットモード waitN=10で実速度0.125sec
Dim waitN As Integer
Dim ctime As Integer
Dim ctime_1 As Integer = 0
'TextBox1.Text = waitN
'RealTimeMotion
If CheckBox2.Checked = True Then
plotC(NVC - 1)
End If
End If
End Sub
'=============================================================================================================================================
Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
SerialPort1.PortName = ComboBox1.SelectedItem ' "COM18" ' TextBox1.Text 'オープンするポート名を格納
SerialPort1.Open() 'ポートオープン
End Sub
'Rover-Base Change +/-
Private Sub CheckBox13_CheckedChanged(sender As Object, e As EventArgs) Handles CheckBox13.CheckedChanged
If CheckBox13.Checked = True Then
RBset = -1
End If
If CheckBox13.Checked = False Then
RBset = 1
End If
End Sub
Private Sub Button2_Click(sender As Object, e As EventArgs) Handles Button2.Click
If fopen = 1 Then
file.Close()
End If
Label2.Text = ""
If SerialPort1.IsOpen = True Then 'ポートオープン済み
SerialPort1.Close() 'ポートクローズ
dataReceivedFlag = 0
End If
End Sub
Private Sub SerialPort1_DataReceived(sender As Object, e As SerialDataReceivedEventArgs) Handles SerialPort1.DataReceived
Dim ReceivedData As String = "" '受信データ用変数を宣言します
dataReceivedFlag = 1
If CheckBox1.Checked = True Then
Try
If RadioButton3.Checked = True Then 'ESP-NOW ASCII INPUT
ReceivedData = SerialPort1.ReadLine 'ASCII CRLF
' ReceivedData = ReceivedData + vbCrLf
Else ' BT,USB Binary INPUT Binary=>HEX RadioButton 2,3 True
Dim arrByte As Byte() = New Byte(SerialPort1.BytesToRead - 1) {}
SerialPort1.Read(arrByte, 0, arrByte.GetLength(0)) 'Binary Receive
ReceivedData = BitConverter.ToString(arrByte) '
End If
Catch ex As Exception
ReceivedData = ex.Message '例外処理を行います
End Try
'Invokeメソッドにより実行されるメソッドへのデリゲートの宣言を行い、受信データを表示します
Dim adre As New DataDelegate(AddressOf PrintData)
Me.Invoke(adre, ReceivedData)
End If
End Sub
'**************************************************************************************************
Private Sub Form1_Activated(sender As Object, e As EventArgs) Handles Me.Activated
'============DIM initialize===============================
'xsize = 1200 'Graph Xsize
'ysize = 400 'Graph Ysize
xsize = PictureBox1.Width
ysize = PictureBox1.Height
axisdiv = 40 ' divsize
Me.AutoScroll = True
ReDim Npbx(30000), Npby(30000), Nprx(30000), Npry(30000)
RBset = 1 'default 1 RoverBase逆付けなら-1
sd1 = ""
sd2 = ""
Me.Text = "SKI_NAV-PVT_RELPOSNED_SkiPictures_rev016"
ReDim sbPVT(100)
ReDim sbRELP(72)
ReDim bPVT(200)
ReDim bRELP(172)
ReDim dgArry(60000, 48)
'dgv1.ColumnCount = 172
'dgv1.RowCount = 2000
ReDim parPVT(100)
ReDim parRELP(72)
'ReDim headPVTArry(47)
'ReDim headRELPArry(15)
For Each sp As String In My.Computer.Ports.SerialPortNames
ComboBox1.Items.Add(sp)
Next
'dgv1.AutoSizeColumnsMode = DataGridViewAutoSizeColumnsMode.AllCells
'For i = 0 To dgv1.ColumnCount - 1
' dgv1.Columns(i).Width = 40
'Next
headPVT = "iTOW,Year,month,day,hour,min,sec,valid,tAcc,nano,fixType,flags,flags2,numSV,lon,lat,height,hMSL,hAcc,vAcc,velN,velE,velD,gSpeed,headMot,sAcc,headAcc,pDOP,flags3,reserved1,headVeh,magDec,magAcc"
headRELP = "R_iTOW,relPosN,relPosE,relPosD,relPosLength,relPosHeading,relPosHPN,relPosHPE,relPosHPD,relPosHPLength,accN,accE,accD,accLength,accHeading"
headPVTArry = Split(headPVT, ",")
headRELPArry = Split(headRELP, ",")
'Debug.Print("FORM:headPVTArry_Length=" & CStr(headPVTArry.Length) & ",headRELPArry Length=" & CStr(headRELPArry.Length))
'ComboBox　初期値
ComboBox2.Items.Clear()
ComboBox2.Items.Add("NoWait")
ComboBox2.Items.Add("10倍速")
ComboBox2.Items.Add("5倍速")
ComboBox2.Items.Add("2倍速")
ComboBox2.Items.Add("1倍速")
ComboBox2.Items.Add("MStep")
ComboBox2.SelectedIndex = 0 'No wait default
'ComboBox3_dgvデータ変換Format===================================================
ComboBox3.Items.Add("BCH->DEC")
ComboBox3.Items.Add("Binary->DEC")
ComboBox3.SelectedIndex = 0 'BCH->DEC Default
End Sub
'=======================UBX Translation=============================================================================
Private Sub PVT_Trans(ByVal NVC As Integer)
'----------------PVT Trans---------------------------------------
' headPVT = "iTOW,Year,month,day,hour,min,sec,valid,tAcc,nano,fixType,flags,flags2,numSV,lon,lat,height,hMSL,hAcc,vAcc,velN,velE,velD,gSpeed,headMot,sAcc,headAcc,pDOP,flags3,reserved1,headVeh,magDec,magAcc"
'Byte OFFSET=5 (header: B5,62,01,07,5C 5 Byte)
Dim off As Integer = 6
'1:iTOW 0-3
parPVT(1) = pvtI4(NVC, 0 + off)
' Debug.Print("parPVT(1)=" & CStr(parPVT(1)))
'2:Year 4-5
parPVT(2) = pvtI2(NVC, 4 + off)
' Debug.Print("parPVT(2)=" & CStr(parPVT(2)))
'3:month 6
parPVT(3) = CInt(bPVT(6 + off))
' Debug.Print("parPVT(3)=" & CStr(parPVT(3)))
'4:day 7
parPVT(4) = CInt(bPVT(7 + off))
' Debug.Print("parPVT(4)=" & CStr(parPVT(4)))
'5:hour 8
parPVT(5) = CInt(bPVT(8 + off))
' Debug.Print("parPVT(5)=" & CStr(parPVT(5)))
'6:min 9
parPVT(6) = CInt(bPVT(9 + off))
' Debug.Print("parPVT(6)=" & CStr(parPVT(6)))
'7:sec 10
parPVT(7) = CInt(bPVT(10 + off))
'Debug.Print("parPVT(7)=" & CStr(parPVT(7)))
'8:valid 11
parPVT(8) = CInt(bPVT(11 + off))
'Debug.Print("parPVT(8)=" & CStr(parPVT(8)))
'9:tAcc 12,13,14,15
parPVT(9) = pvtI4(NVC, 12 + off)
' Debug.Print("parPVT(9)=" & CStr(parPVT(9)))
'10:nano 16
parPVT(10) = CInt(bPVT(16 + off))
'Debug.Print("parPVT(10)=" & CStr(parPVT(10)))
'11:fixType 20
parPVT(11) = CInt(bPVT(20 + off))
'Debug.Print("parPVT(11)=" & CStr(parPVT(11)))
'12:flags 21
parPVT(12) = CInt(bPVT(21 + off))
' Debug.Print("parPVT(12)=" & CStr(parPVT(12)))
'13:flags2 22
parPVT(13) = CInt(bPVT(22 + off))
' Debug.Print("parPVT(13)=" & CStr(parPVT(13)))
'14:numSV 23
parPVT(14) = CInt(bPVT(23 + off))
' Debug.Print("parPVT(14)=" & CStr(parPVT(14)))
'15:lon'24,25,26,27
parPVT(15) = pvtI4(NVC, 24 + off)
' Debug.Print("parPVT(15)=" & CStr(parPVT(15)))
'16:lat 28,29,30,31
parPVT(16) = pvtI4(NVC, 28 + off)
' Debug.Print("parPVT(16)=" & CStr(parPVT(16)))
'17:height 32,33,34,35
parPVT(17) = pvtI4(NVC, 32 + off)
' Debug.Print("parPVT(17)=" & CStr(parPVT(17)))
'18:hMSL 36,37,38,39
parPVT(18) = pvtI4(NVC, 36 + off)
' Debug.Print("parPVT(18)=" & CStr(parPVT(18)))
'19:hAcc 40,41,42,43
parPVT(19) = pvtI4(NVC, 40 + off)
' Debug.Print("parPVT(19)=" & CStr(parPVT(19)))
'20:vAcc 44,45,46,47
parPVT(20) = pvtI4(NVC, 44 + off)
' Debug.Print("parPVT(20)=" & CStr(parPVT(20)))
'21:velN 48,49,50,51
parPVT(21) = pvtI4(NVC, 48 + off)
' Debug.Print("parPVT(21)=" & CStr(parPVT(21)))
'22:velE 52,53,54,55
parPVT(22) = pvtI4(NVC, 52 + off)
' Debug.Print("parPVT(22)=" & CStr(parPVT(22)))
'23:velD 56,57,58,59
parPVT(23) = pvtI4(NVC, 56 + off)
' Debug.Print("parPVT(23)=" & CStr(parPVT(23)))
'24:gSpeed 60,61,62,63
parPVT(24) = pvtI4(NVC, 60 + off)
'Debug.Print("parPVT(24)=" & CStr(parPVT(24)))
'25:headMot 64,65,66,67
parPVT(25) = pvtI4(NVC, 64 + off)
' Debug.Print("parPVT(25)=" & CStr(parPVT(25)))
'26:sAcc 68,69,70,71
parPVT(26) = pvtI4(NVC, 68 + off)
' Debug.Print("parPVT(26)=" & CStr(parPVT(26)))
'27:headAcc 72,73,74,75
parPVT(27) = pvtI4(NVC, 72 + off)
' Debug.Print("parPVT(27)=" & CStr(parPVT(27)))
'28:pDOP 76,77
parPVT(28) = pvtI2(NVC, 76 + off)
' Debug.Print("parPVT(28)=" & CStr(parPVT(28)))
'29:flags3 78
parPVT(29) = CInt(bPVT(78 + off))
' Debug.Print("parPVT(29)=" & CStr(parPVT(29)))
'30:reserved1 79,80,81,82
parPVT(30) = pvtI4(NVC, 79 + off)
' Debug.Print("parPVT(30)=" & CStr(parPVT(30)))
'31:headVeh 83,84,85,86
parPVT(31) = pvtI4(NVC, 83 + off)
'Debug.Print("parPVT(31)=" & CStr(parPVT(31)))
'32:magDec 88,89
parPVT(32) = pvtI2(NVC, 88 + off)
' Debug.Print("parPVT(32)=" & CStr(parPVT(32)))
'33:magAcc 90,91
parPVT(33) = pvtI2(NVC, 90 + off)
' Debug.Print("parPVT(33)=" & CStr(parPVT(33)))
End Sub
Private Sub RELP_Trans(ByVal NVC As Integer)
'----------------PVT Trans---------------------------------------
' headRELP = "R_iTOW,relPosN,relPosE,relPosD,relPosLength,relPosHeading,relPosHPN,relPosHPE,relPosHPD,relPosHPLength,accN,accE,accD,accLength,accHeading"
'Byte OFFSET=5 (header: B5,62,01,07,5C 5 Byte)
Dim off As Integer = 6
'---------1:iTOW 4-7
parRELP(1) = relpI4(NVC, 4 + off)
'Debug.Print("parRELP(1)=" & CStr(parRELP(1)))
'---------2:relPosN 8-11
parRELP(2) = relpI4(NVC, 8 + off)
'Debug.Print("parRELP(2)=" & CStr(parRELP(2)))
'---------3:relPosE 12-15
parRELP(3) = relpI4(NVC, 12 + off)
'Debug.Print("parRELP(3)=" & CStr(parRELP(3)))
'---------4:relPosD 16-19
parRELP(4) = relpI4(NVC, 16 + off)
'Debug.Print("parRELP(4)=" & CStr(parRELP(4)))
'---------5:relPosLength 20-23
parRELP(5) = relpI4(NVC, 20 + off)
'Debug.Print("parRELP(5)=" & CStr(parRELP(5)))
'---------6:relPosHeading 24-27
parRELP(6) = relpI4(NVC, 24 + off)
'Debug.Print("parRELP(6)=" & CStr(parRELP(6)))
'---------7:relPosHPN 32
parRELP(7) = CInt(bRELP(32 + off))
'Debug.Print("parRELP(7)=" & CStr(parRELP(7)))
'---------8:relPosHPE 33
parRELP(8) = CInt(bPVT(36 + off))
'Debug.Print("parRELP(8)=" & CStr(parRELP(8)))
'---------9:relPosHPD 34
parPVT(9) = CInt(bPVT(34 + off))
'Debug.Print("parRELP(9)=" & CStr(parRELP(9)))
'--------10:relPosHPLength 35
parRELP(10) = CInt(bPVT(35 + off))
'Debug.Print("parRELP(10)=" & CStr(parRELP(10)))
'--------11:accN 36-39
parRELP(11) = relpI4(NVC, 36 + off)
'Debug.Print("parRELP(11)=" & CStr(parRELP(11)))
'--------12:accE 40-43
parRELP(12) = relpI4(NVC, 40 + off)
'Debug.Print("parRELP(12)=" & CStr(parRELP(12)))
'--------13:accD 44-47
parRELP(13) = relpI4(NVC, 44 + off)
'Debug.Print("parRELP(13)=" & CStr(parRELP(13)))
'--------14:accLength 48-51
parRELP(14) = relpI4(NVC, 48 + off)
'Debug.Print("parRELP(14)=" & CStr(parRELP(14)))
'--------15:accHeading 52-55
parRELP(15) = relpI4(NVC, 52 + off)
'Debug.Print("parRELP(15)=" & CStr(parRELP(15)))
End Sub
'=====================================================BInary To Decimal ===============================================================================
'-------------------------------PVT----------------------------------------------------
Private Function pvtI4(ByVal dnum As Integer, ByVal sN As Integer) As Integer
Dim i4 As Integer
' Debug.Print("In_pvtI4:bPVT()=" & CStr(sN) & "::" & CStr(bPVT( sN)) & "," & CStr(bPVT( sN + 1)) & "," & CStr(bPVT( sN + 2)) & "," & CStr(bPVT( sN + 3)))
If (bPVT(sN + 3) And &H80) And &H80 Then '{//4番目のBYTEの最上位ビットたっていればマイナス
'Debug.Print("-bPVT*65536=" & CStr(CLng((bPVT( sN + 2) * 65536))))
'Debug.Print("-bPVT*256*256*256=" & CStr(CLng(255 - bPVT( sN + 3)) * 16777216))
i4 = -CLng(256 - (bPVT(sN)) + CLng(255 - bPVT(sN + 1)) * 256 + CLng(255 - bPVT(sN + 2)) * 65536 + CLng(255 - bPVT(sN + 3)) * 16777216)
Else
'Debug.Print("+bPVT*65536=" & CStr(sN) & "::" & CStr(bPVT( sN + 2) * 65536))
'Debug.Print("+bPVT*256*256*256=" & CStr(sN) & "::" & CStr(bPVT( sN + 3) * 256 * 256 * 256))
i4 = CLng(bPVT(sN) * 1 + CLng(bPVT(sN + 1)) * 256 + CLng(bPVT(sN + 2)) * 65536 + CLng(bPVT(sN + 3)) * 256 * 256 * 256)
End If
Return i4
End Function
Private Function pvtI2(ByVal dnum As Integer, ByVal sN As Integer) As Integer
Dim i2 As Integer
i2 = bPVT(sN + 1) * 1 + bPVT(sN) * 256
Return i2
End Function
'------------------RELPOSNED --------------------------------------------------
Private Function relpI4(ByVal dnum As Integer, ByVal sN As Integer) As Integer
Dim i4 As Integer
If (bRELP(sN + 3) And &H80) And &H80 Then '{//4番目のBYTEの最上位ビットたっていればマイナス
i4 = -CLng(256 - (bRELP(sN)) + CLng(255 - bRELP(sN + 1)) * 256 + CLng(255 - bRELP(sN + 2)) * 65536 + CLng(255 - bRELP(sN + 3)) * 16777216)
Else
i4 = CLng(bRELP(sN) * 1 + CLng(bRELP(sN + 1)) * 256 + CLng(bRELP(sN + 2)) * 65536 + CLng(bRELP(sN + 3)) * 256 * 256 * 256)
End If
Return i4
End Function
Private Function relpI2(ByVal dnum As Integer, ByVal sN As Integer) As Integer
Dim i2 As Integer
i2 = bRELP(sN + 1) * 1 + bRELP(sN) * 256
Return i2
End Function
Private Sub TextBox1_TextChanged(sender As Object, e As EventArgs) Handles TextBox1.TextChanged
End Sub
'================================================================================================
'BinaryHEXファイルをUBX変換：dgv1 Data Format 変換ボタン押し-dgv1に読み込まれたファイルを変換
'===============================================================================================
Private Sub Button10_Click(sender As Object, e As EventArgs) Handles Button10.Click
'Debug.Print("dgv1.rowcount=" & CStr(dgv1.RowCount))
dataSu2 = dgv1.RowCount
Dim ketasu2 As Integer = dgv1.ColumnCount
'sw.Start()
'Debug.Print("Format Trans BCH->DEC startTime=" & CStr(sw.ElapsedMilliseconds))
'BCH->DEC NAV-PVT+NAV-RELPOSNEDの16進数表記をDEC変換-----------------------------------------------------------
Dim startOff As Integer
If dgv1.Rows(0).Cells(0).Value = "B5" Then
startOff = 0
End If
'If dgv1.Rows(0).Cells(1).Value = "B5" Then
If dgv1.Rows(0).Cells(0).Value = "" Then
startOff = 1
End If
If ComboBox3.SelectedIndex = 0 Then
'bPVT(),bRELP()に代入してFunction pvtI4()とrelpI4()で整数化してparPVT(1-33)とparRELP(1-15)に入れてdgv1書き換え
For i = 0 To dataSu2 - 2 ' Last Row Error Kaihi
'PVTとRELPOSNED16進数string配列sbPVT(),sbRELP()をByte配列bPVT(),bRELP()に変換--------------------------------------------
For j = 0 To 99
sbPVT(j) = dgv1.Rows(i).Cells(j + startOff).Value
bPVT(j) = Convert.ToByte(sbPVT(j), 16)
'Debug.Print("bPVT(" & CStr(NVC) & "," & CStr(j) & ")=" & CStr(bPVT(j)) & ":" & sbPVT(j))
Next
For j = 0 To 71
sbRELP(j) = dgv1.Rows(i).Cells(j + startOff + 100).Value
bRELP(j) = Convert.ToByte(sbRELP(j), 16)
'bRELP(j) = Convert.ToByte(sbRELP(j), 16)
'Debug.Print("bRELP(" & CStr(NVC) & "," & CStr(j) & ")=" & CStr(bRELP(j)) & ":" & sbRELP(j))
Next
'bPVT()、bRELPからDECへ変換してparPVT(),parRELP()を得る
PVT_Trans(i)
RELP_Trans(i)
'parPVT(),parRELP()をdgArry(,)に書き込み
For k = 0 To 33 - 1
dgArry(i, k) = parPVT(k + 1)
'Debug.Print("dgArry(" & CStr(i) & "," & CStr(k) & ")=" & CStr(dgArry(i, k)))
Next k
For k = 0 To 15 - 1
dgArry(i, k + 33) = parRELP(k + 1)
' Debug.Print("dgArry(" & CStr(i) & "," & CStr(k + 33) & ")=" & CStr(dgArry(i, k + 33)))
Next k
'For k = 0 To 33 - 1
' dgv1.Rows(i).Cells(k).Value = parPVT(k + 1)
'Next k
'For k = 0 To 15 - 1
' dgv1.Rows(i).Cells(k + 100).Value = parRELP(k + 1)
'Next k
'Debug.Print("Binary Loop=" & CStr(i))
Next
dgv1.Rows.Clear()
dgv1.Columns.Clear()
' Debug.Print("Format Trans BCH->DEC EndTime=" & CStr(sw.ElapsedMilliseconds) & "RowCount=" & CStr(dataSu))
dgv1.RowCount = dataSu2 - 1
dgv1.ColumnCount = 49
For i = 0 To 32
dgv1.Columns(i + 1).HeaderText = headPVTArry(i)
Next
For i = 0 To 14
dgv1.Columns(i + 33 + 1).HeaderText = headRELPArry(i)
Next
For i = 0 To dataSu2 - 5
'Row No add
dgv1.Rows(i).HeaderCell.Value = CStr(i)
For j = 0 To 47
dgv1.Rows(i).Cells(j + 1).Value = dgArry(i, j)
'Debug.Print("dgArry(" & CStr(i) & "," & CStr(j) & ")=" & CStr(dgArry(i, j)))
Next
Next
End If
End Sub
Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load
End Sub
Private Sub pvt_relpHead()
'--PVTヘッダー
dgv1.Columns(1).HeaderText = "iTow"
dgv1.Columns(1).Width = 60
dgv1.Columns(2).HeaderText = "fixType"
dgv1.Columns(3).HeaderText = "numSV"
dgv1.Columns(4).HeaderText = "lon"
dgv1.Columns(5).HeaderText = "lat"
Dim lat As Integer = parPVT(16)
dgv1.Columns(6).HeaderText = "height"
Dim height As Integer = parPVT(17)
dgv1.Columns(7).HeaderText = "hAcc"
Dim hAcc As Integer = parPVT(19)
dgv1.Columns(8).HeaderText = "vAcc"
Dim vAcc As Integer = parPVT(20)
dgv1.Columns(9).HeaderText = "velN"
Dim velN As Integer = parPVT(21)
dgv1.Columns(10).HeaderText = "velE"
Dim velE As Integer = parPVT(22)
dgv1.Columns(11).HeaderText = "velD"
Dim velD As Integer = parPVT(23)
'--RELPOSNED ヘッダー
dgv1.Columns(12).HeaderText = "RELP_iTow"
Dim RELP_iTOW As Integer = parRELP(1)
dgv1.Columns(13).HeaderText = "relPosN"
Dim relPosN As Single = parRELP(2) + parRELP(7) * 0.1
dgv1.Columns(14).HeaderText = "relPosE"
Dim relPosE As Single = parRELP(3) + parRELP(8) * 0.1
dgv1.Columns(15).HeaderText = "relPosD"
Dim relPosD As Single = parRELP(4) + parRELP(9) * 0.1
dgv1.Columns(16).HeaderText = "relPosLength"
Dim relPosLength As Single = parRELP(5) + parRELP(10) * 0.1
dgv1.Columns(17).HeaderText = "relPosHeading"
Dim relPosHeading As Single = parRELP(6) * 0.00001
dgv1.Columns(18).HeaderText = "accN"
Dim accN As Single = parRELP(11) * 0.01
dgv1.Columns(19).HeaderText = "accE"
Dim accE As Single = parRELP(12) * 0.01
dgv1.Columns(20).HeaderText = "accD"
Dim accD As Single = parRELP(13) * 0.01
dgv1.Columns(21).HeaderText = "accLength"
Dim accLength As Single = parRELP(14) * 0.01
dgv1.Columns(22).HeaderText = "accHeading"
Dim accHeading As Single = parRELP(15) * 0.00001
End Sub
'=========================================================================================================================================================
'=========================================================================================================================================================
'FILE READ /Write Sub
'=========================================================================================================================================================
'========================================================================================================================================================
'【MB_LogFile名指定ボタン 3 file Open 】
Private Sub Button3_Click(sender As Object, e As EventArgs) Handles Button3.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 = "MB_" + fname
sfd.Filter = "TXTファイル|*.txt|CSVファイル|*.csv|すべてのファイル|*.*"
sfd.InitialDirectory = "C:\RTK_Log "
sfd.FilterIndex = 2
sfd.Title = "保存先のファイルを選択してください"
' ダイアログボックスを閉じる前に現在のディレクトリを復元する (初期値 False)
sfd.RestoreDirectory = True
If sfd.ShowDialog() = DialogResult.OK Then
'OKボタンがクリックされたとき、選択されたファイル名を表示する
Console.WriteLine(sfd.FileName)
TextBox2.Text = sfd.FileName
End If
fname = TextBox2.Text
' fname = "C:\RTK_Log\MB_" & fname & ".csv"
'TextBox2.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)
fopen = 1 'file Open Flag
file.Write(fname + vbCrLf) 'File Name write
' file.Close()
'------Header text write----------------------
file.Write("NVC," + headPVT + "," + headRELP + vbCrLf)
End Sub
'================================================================================================
'=============================ファイル READ ボタン CSV/UBX=======================================
'=================================================================================================
Private Sub Button4_Click(sender As Object, e As EventArgs) Handles Button4.Click
If RadioButton4.Checked = True Then
CSV_DGV(1)
End If
If RadioButton5.Checked = True Then
UBX_DEC()
End If
End Sub
'--------------------------------------------------------------------------------------------------
'UBXファイルを読み込んで BinaryをHEXASCIに変換して、DGV表示　NAV-PVT+NAV-RELPOSNEDを1行で表示する
Private Sub UBX_DEC()
Dim Path As String = readfile() 'Dialogから読み込むファイル名指定
Dim fs As New FileStream(Path, FileMode.Open, FileAccess.Read)
Dim fileSize As Integer = CInt(fs.Length) ' ファイルのサイズ
Dim buf(fileSize - 1) As Byte ' データ格納用配列
Dim readSize As Integer ' Readメソッドで読み込んだバイト数
Dim remain As Integer = fileSize ' 読み込むべき残りのバイト数
Dim bufPos As Integer = 0 ' データ格納用配列内の追加位置
'Dim ubxstr As String
dgv1.RowCount = Int(fileSize / 172) 'Fileサイズから行数
dgv1.ColumnCount = 172 ' 17sbyte収納
readSize = fs.Read(buf, 0, fs.Length)
'While remain > 0
' 172Bytesずつ読み込む
'readSize = fs.Read(buf, bufPos, Math.Min(1024, remain))
bufPos += readSize
remain -= readSize
'ubxstr = BitConverter.ToString(buf)
'Debug.Print(ubxstr)
'dgvへ書き込み
For i = 0 To Int(fileSize / 172) - 1
'dgv1へ書き込む時に1桁目をあけて書き込む＝＞buttun10の変換処理用
For j = 0 To 171 'dgv1.ColumnCount - 1
''debug.Print("DGV_rdata(" & CStr(i) & "," & CStr(j) & ")=" & CStr(dreadata(i, j)))
' var hexString = BytesToString(bytes);
dgv1.Rows(i).Cells(j + 1).Value = Convert.ToString(buf(j + i * 172), 16)
Next j
Next i
'End While
'--------------------------------------------------------------------------------------------------------
End Sub
Private Sub CSV_DGV(dN As Integer)
NVC = 1
Dim datasu As Integer
Dim maxRowCSV As Integer
Dim Col2nd As Integer
Dim headerFlg As Integer
Dim rIndex As Integer
'dgN = dN
''---------dgv サイズ表示-------
'TextBox4.Text = dgv1.Columns.Count
'TextBox5.Text = dgv1.Rows.Count
''----------------------------------
'If CheckBox26.Checked = True Then
'-----2ndFile追加の場合-----------------------------------------------------------
'If CheckBox11.Checked = True Then
' If dgv1.ColumnCount = 48 Then
' Label21.Text = "2ndFile CSV_DGV Stating"
' Else
' Label21.Text = "DGV1 colum数が48でない"
' End If
'End If
If CheckBox11.Checked = True Then
'Debug.Print("2nd File CSV_DGV col=49 start ")
Col2nd = dgv1.ColumnCount
ElseIf CheckBox11.Checked = True And dgv1.ColumnCount <> 48 Then
ElseIf CheckBox11.Checked = False Then
Col2nd = 0
'------dgv初期化--------------
dgv1.Columns.Clear（）
dgv1.DataSource = Nothing
End If
'-------------------------------------------------------------------------------
'------File名Path-------------------
Dim Path As String = readfile() 'Dialogから読み込むファイル名指定
Label3.Text = Path
'-------ファイルの行数----------------
maxRowCSV = GetLinesOfTextFile(Path)
'Label1.Text = CStr(maxRowCSV) & "行"
'--------CSVァイル読み込み-----------------
Label2.Text = "CSV File Loaded"
datasu = CSV_crlf(Path) 'ファイルの改行数なのでHeader行も含まれる行数なのでRowではない
'Label2.Text = "CSV File Read Finished"
'--------dgv ヘッダー処理--------------------
Dim hIndex As Integer = 0
If dreadata(0, 0).IndexOf(".csv") >= 0 Then
hIndex = 1
End If
If IsNumeric(dreadata(hIndex, 0)) = False Then 'ヘッダーあり
' Label1.Text = "ヘッダーあり"
dgv1.RowCount = datasu - 1 'ヘッダー行を差し引いてDGVの行を作る
'debug.Print("dcIndex_max=" & CStr(dcIndex_max))
dgv1.ColumnCount = dcIndex_max + Col2nd
headerFlg = 1
End If
If IsNumeric(dreadata(hIndex, 0)) = True Then 'ヘッダーなし
'Label1.Text = "ヘッダーなし"
dgv1.RowCount = datasu 'データ数分DGVの行を作る
'debug.Print("dcIndex_max=" & CStr(dcIndex_max))
dgv1.ColumnCount = dcIndex_max + Col2nd
headerFlg = 0
End If
''========================Header Col作成=================
If IsNumeric(dreadata(hIndex, 0)) = False Then 'ヘッダーがある場合
For j = 0 To dcIndex_max - 1
dgv1.Columns(j + Col2nd).HeaderText = dreadata(hIndex, j) 'dgvの列Header　Property定義
Next
End If
'=========CSVから全データ配列 redata(maxRowCSV,cIndex)==========
rIndex += 1
For i = 0 To dgv1.RowCount - 1
For j = 0 To dgv1.ColumnCount - 1 - Col2nd '1その行の列数は、dreadata(行,0)に格納されている
dgv1.Rows(i).Cells(j + Col2nd).Value = dreadata(i + headerFlg + hIndex, j)
' Debug.Print("DGV_rdata(" & CStr(i) & "," & CStr(j + Col2nd) & ")=" & CStr(dreadata(i + headerFlg + hIndex, j)))
Next j
'Row No add
dgv1.Rows(i).HeaderCell.Value = CStr(i)
Debug.Print("rowHeader i=" & CStr(i))
Next i
Dim checkRowN As Integer = dgv1.RowCount
Dim checkColumnN As Integer = dgv1.ColumnCount
'End If
'maxRowCol()
End Sub
Private Sub CheckBox1_CheckedChanged(sender As Object, e As EventArgs) Handles CheckBox1.CheckedChanged
If CheckBox1.Checked = False Then
Button2.Enabled = True
dataReceivedFlag = 1
Else
Button2.Enabled = False
dataReceivedFlag = 0
End If
End Sub
Private Function readfile() As String
Dim ofd As New OpenFileDialog()
'はじめのファイル名を指定する
'はじめに「ファイル名」で表示される文字列を指定する
ofd.FileName = "yyyyMMdd_HHmmss" '"default.html"
'はじめに表示されるフォルダを指定する
'指定しない（空の文字列）の時は、現在のディレクトリが表示される
ofd.InitialDirectory = "C:\RTK_Log "
'[ファイルの種類]に表示される選択肢を指定する
'指定しないとすべてのファイルが表示される
ofd.Filter = "TXTファイル|*.txt|CSVファイル|*.csv|すべてのファイル|*.*"
'[ファイルの種類]ではじめに選択されるものを指定する
'2番目の「すべてのファイル」が選択されているようにする
ofd.FilterIndex = 2
'タイトルを設定する
ofd.Title = "開くファイルを選択してください"
'ダイアログボックスを閉じる前に現在のディレクトリを復元するようにする
ofd.RestoreDirectory = True
'存在しないファイルの名前が指定されたとき警告を表示する
'デフォルトでTrueなので指定する必要はない
ofd.CheckFileExists = True
'存在しないパスが指定されたとき警告を表示する
'デフォルトでTrueなので指定する必要はない
ofd.CheckPathExists = True
If ofd.ShowDialog() = DialogResult.OK Then
'OKボタンがクリックされたとき、選択されたファイル名を表示する
'debug.Print(ofd.FileName)
End If
Return ofd.FileName
End Function
'DGV error Remove---------------------------------------------------------------
Private Sub Button11_Click(sender As Object, e As EventArgs) Handles Button11.Click
' relError()
itowError()
End Sub
' Header b5 cHECK
Private Sub Button12_Click(sender As Object, e As EventArgs) Handles Button12.Click
RichTextBox1.AppendText("Check Header b5")
b5Error()
End Sub
'iTow　チェック
'ROW 処理　
'.Rows.Insert(i)/
Sub itowError()
Dim iniRow As Integer = dgv1.RowCount
Dim currRow As Integer = iniRow
Dim errRN As Integer = 0
Dim gyouN As Integer
Dim ketaN As Integer
Dim itowColN As Integer
'-------------iTow headerr Search------------------------------------------------
For i = 0 To 48
If dgv1.Columns(i).HeaderText = "iTOW" Then
itowColN = i
Exit For
End If
Next i
i = 1
While i < currRow - 5
Dim itowSa As Integer = dgv1.Rows(i).Cells(itowColN).Value - dgv1.Rows(i - 1).Cells(itowColN).Value
If itowSa > 125 Or itowSa < 125 Then
' dgv1.Rows.RemoveAt(i)
' For gyoN = 0 To Int(itowSa / 125) - 1
' dgv1.Rows.Insert(i + gyoN)
' currRow = iniRow + 1
'行コピー-----------------------------------------------------------------
'For ketaN = 0 To dgv1.ColumnCount - 1
'dgv1.Rows(i + gyoN).Cells(ketaN).Value = dgv1.Rows(i).Cells(ketaN).Value
'Next ketaN
'-------------------------------------------------------------------------
errRN += 1
RichTextBox1.AppendText(CStr(errRN) & "itow(" & CStr(i) & ")=" & CStr(dgv1.Rows(i).Cells(itowColN).Value) & ":itow(" & CStr(i - 1) & ")=" & CStr(dgv1.Rows(i - 1).Cells(itowColN).Value) & vbCrLf)
' Next gyoN
End If
i += 1
End While
Label23.Text = "iniRow=" & CStr(iniRow) & "errRN=" & CStr(errRN) & "CurRowCount=" & CStr(dgv1.RowCount)
End Sub
Sub relError()
Dim iniRow As Integer = dgv1.RowCount
Dim errRN As Integer = 0
i = 0
While i < dgv1.RowCount - 5
If i = 520 Then
i = i
End If
If dgv1.Rows(i).Cells(35).Value > 1000 Or dgv1.Rows(i).Cells(36).Value > 1000 Or dgv1.Rows(i).Cells(37).Value > 1000 Then
dgv1.Rows.RemoveAt(i)
errRN += 1
End If
i += 1
End While
Label24.Text = "iniRow=" & CStr(iniRow) & "errRN=" & CStr(errRN) & "CurRowCount=" & CStr(dgv1.RowCount)
End Sub
Sub b5Error() ' header b5 Exist
Dim iniRow As Integer = dgv1.RowCount
Dim currRow As Integer = iniRow
Dim errRN As Integer = 0
i = 0
While i < currRow - 5
If dgv1.Rows(i).Cells(1).Value <> "b5" Then
dgv1.Rows.RemoveAt(i)
currRow = iniRow - 1
errRN += 1
RichTextBox1.AppendText("PVT b5 Error:rowN0=" & CStr(errRN) & "Deleted")
End If
If dgv1.Rows(i).Cells(101).Value <> "b5" Then
dgv1.Rows.RemoveAt(i)
currRow = iniRow - 1
errRN += 1
RichTextBox1.AppendText("REL b5 Error:rowN0=" & CStr(errRN) & "Deleted")
End If
i += 1
End While
Label23.Text = "iniRow=" & CStr(iniRow) & "errRN=" & CStr(errRN) & "CurRowCount=" & CStr(dgv1.RowCount)
End Sub
'==========================================================================================
'===================CSVファイル読み込み ＣｒＬｆ付 FILE Read Function=================================================
'======================================================================================
Private Function CSV_crlf(ByVal fnm As String) As Integer '戻り値はデータ行数 データはdreadata(rdataN,dcindex)
Using parser As New TextFieldParser(fnm, System.Text.Encoding.GetEncoding("Shift_JIS"))
parser.TextFieldType = FieldType.Delimited
'Delimiter Selection------------------------------
If CheckBox10.Checked = True Then 'Canmma
parser.SetDelimiters(",") ' 区切り文字はコンマ
End If
'If CheckBox11.Checked = True Then '2ndFile 読み込みはiTowを合わせて書き込む
' 'ファイルはUBXDEC済みのみ対応48桁
' 'parser.SetDelimiters(vbTab) ' 区切り文字はコン
'End If
' parser.HasFieldsEnclosedInQuotes = False
' parser.TrimWhiteSpace = False
dcIndex = 0
dcIndex_max = 0
rdataN = 0
While Not parser.EndOfData
Dim row As String() = parser.ReadFields() ' 1行読み込み
For Each field As String In row
dreadata(rdataN, dcIndex) = field
' Debug.Print("field=" & field)
' Debug.Print("dreadata(" & CStr(rdataN) & "," & CStr(dcIndex) & ")=" & dreadata(rdataN, dcIndex))
dcIndex += 1
Next
If dcIndex > dcIndex_max Then
dcIndex_max = dcIndex
End If
dcIndex = 0
rdataN += 1
End While
End Using
Return rdataN
End Function
'============================CSVファイル　総行数カウントFunction==============================
Public Function GetLinesOfTextFile(ByVal FileName As String) As Integer
Dim StReader As New System.IO.StreamReader(FileName)
Dim LineCount As Integer
While (StReader.Peek() >= 0)
StReader.ReadLine()
LineCount += 1
End While
Return LineCount
End Function
'【DGV まるごとSave】
Private Sub Button5_Click(sender As Object, e As EventArgs) Handles Button5.Click
'---------dgv SCPmode保存ファイル準備------------------------------
fnameH = Format(Now, "yyyyMMdd_HHmmss")
fStr1 = "DGV_" 'ComboBox9.SelectedItem.ToString()
fnameH = "C:\RTK_Log\" & 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
Label1.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
'===================================================================================================
'Graphic 前処理 =================================================================
'===================================================================================================
'rePlay ボタン押し
Private Sub Button8_Click(sender As Object, e As EventArgs) Handles Button8.Click
rePlay()
pcount = 0
Dim prange As String = TextBox4.Text & "," & TextBox5.Text
ComboBox4.Items.Add(prange)
End Sub
'Combobox で過去PLOT範囲読みだし
Private Sub ComboBox4_SelectedValueChanged(sender As Object, e As EventArgs) Handles ComboBox4.SelectedValueChanged
Dim aryStrings
Dim strVal As String = ComboBox4.SelectedItem
aryStrings = Split(strVal, ",")
TextBox4.Text = aryStrings(0)
TextBox5.Text = aryStrings(1)
End Sub
''水平スクロールバータッチ
'Private Sub HScrollBar2_Scroll(sender As Object, e As ScrollEventArgs) Handles HScrollBar2.Scroll
' zLon_1 = zLon
'End Sub
'水平位置スクロールバー移動 フル10m移動　100で10m
Private Sub HScrollBar2_ValueChanged(sender As Object, e As EventArgs) Handles HScrollBar2.ValueChanged
offX = Int((HScrollBar2.Value - 50) / 100 * 1200)
'zLon_1 = Int(60 * (HScrollBar2.Value - 50)) ' /10)
End Sub
'垂直スクロールバー移動
Private Sub VScrollBar1_ValueChanged(sender As Object, e As EventArgs) Handles VScrollBar1.ValueChanged
offY = Int((VScrollBar1.Value - 50) / 100 * 600)
'zLat_1 = Int(10 * (VScrollBar1.Value - 50) / 10)
End Sub
'rScaleを変更したときのhScrollbar1の値Value変更
'Private Function HSValue_rScale(scale As Single) As Integer
' 'Dim value As Integer
' 'If scale < 1 Then 'Value=int(49.985*rscale+0.0695)
' ' value = Int((49.985 * scale) + 0.0695)
' 'End If
' 'If scale >= 1 Then 'Value=5*rScale+45
' ' value = Int(5 * scale + 45)
' 'End If
' 'HScrollBar1.Value = value
' Return value
'End Function
'スクロールバーで縮尺を変更した場合の処理--------------------------------------------------------------
'Private Sub HScrollBar1_MouseUp(sender As Object, e As MouseEventArgs) Handles HScrollBar1.MouseUp
' rScale = Vrscale(HScrollBar1.Value)
' 'If HScrollBar1.Value <= 1 Then
' ' rScale = 0.001
' 'End If
' 'If 1 < HScrollBar1.Value And HScrollBar1.Value < 50 Then 'rScale=(Value-0.0695)/49.985
' ' rScale = (HScrollBar1.Value - 0.0695) / 49.985
' 'End If
' 'If HScrollBar1.Value >= 50 Then 'Rscale=(Value-45)/5
' ' rScale = (HScrollBar1.Value - 45) / 5
' 'End If
' Label13.Text = "divsize=" & Int(axisdiv / rScale) & "cm X " & Int(axisdiv / rScale) & "cm"
' TextBox1.Text = rScale 'HScrollBar1.Value
'End Sub
'AutoScale押し　センタリングとスケール全自動で全体像表示
Private Sub Button9_Click(sender As Object, e As EventArgs) Handles Button9.Click
'センタリング
centering()
'' scale計算
'lonratio = xsize / (Maxlon - Minlon) 'dot/cm 全X幅をLon全幅とするスケール値
' latiratio = ysize / (Maxlati - Minlati) 'dot/cm全Y高さをLati全高さとするスケール値
' If lonratio > latiratio Then
' rScale = latiratio
' Else
' rScale = lonratio
' End If
' If rScale > 10 Then
' rScale = 10
' End If
' HSValue_rScale(rScale)
'End If
'AutoViewの結果として全幅全高cm表示
Label13.Text = "divsize=" & Int(axisdiv / rScale) & "cm X " & Int(axisdiv / rScale) & "cm"
Label4.Text = "[lonw=" & CInt((Maxlon - Minlon) / 100) & "m:Latiw=" & CInt((Maxlati - Minlati) / 100) & "]W=" & Int(xsize / rScale) & "m:H=" & CInt((ysize / rScale) / 100) & "cm"
TextBox1.Text = CStr(rScale)
End Sub
'checkBox8 XY座標交換
Private Sub CheckBox8_CheckedChanged(sender As Object, e As EventArgs) Handles CheckBox8.CheckedChanged
If CheckBox8.Checked = True Then
col_lon = dumLati
col_lati = dumLon
col_N = dumE
col_E = dumN
End If
If CheckBox8.Checked = False Then
col_lon = dumLon
col_lati = dumLati
col_N = dumN
col_E = dumE
End If
End Sub
'rePlay():指定スタート行からエンド行までグラフプロットをリプレイする速度指定付--------------
Private Sub rePlay() '(startRowN As Integer, endRowN As Integer, speed As Single)
Dim ir As Integer '再生行No
Dim periodT As Integer
Dim periodT_1 As Integer
Dim selPT As Integer
'ComboBox2 wait time read
Dim selI As Integer = ComboBox2.SelectedIndex
Select Case selI
Case 0 'NO wait
selPT = 0
Case 1 '10倍速 12msec-4msec refresh遅延
selPT = 8
Case 2 '5倍速 25msec-4msec refresh遅延
selPT = 21
Case 3 '2倍速 63msec-4msec refresh遅延
selPT = 240'63
Case 4 '1倍速 125msec-4msec refresh遅延
selPT = 440
Case 5
selPT = 680
End Select
'Debug.Print("case Select Index,time=" & CStr(selI) & "," & CStr(selPT))
If Int(TextBox4.Text) >= 0 And Int(TextBox5.Text) > 0 Then
Label14.Text = "PlotStart"
TextBox6.Text = "PlotStart"
Dim stN As Integer = Int(TextBox4.Text)
Dim enN As Integer = Int(TextBox5.Text)
sw.Start()
'Debug.Print("plotstart=" & CStr(sw.ElapsedMilliseconds))
For ir = stN To enN 'enN
periodT_1 = sw.ElapsedMilliseconds
While periodT - periodT_1 < selPT
periodT = sw.ElapsedMilliseconds
'Debug.Print("periodTime=" & CStr(periodT - periodT_1))
End While
Label14.Text = "Plotting"
TextBox6.Text = "Plotting"
If stepFlag = 0 Then
plotC(ir)
If CheckBox11.Checked = True Then
plotC2(ir)
End If
'-----重要---------------------------------
PictureBox1.Refresh() '毎回表示にRefresh必要
'-------------------------------------------
Else stepFlag = 1
Debug.Print("sterpFlag=1" & "ir=" & CStr(ir) & "mclick=1")
While (mClick = 1)
plotC(ir)
If CheckBox11.Checked = True Then
plotC2(ir)
End If
'-----重要---------------------------------
PictureBox1.Refresh() '毎回表示にRefresh必要
'-------------------------------------------
Label14.Text = CStr(ir)
End While
End If
'Label14.Text = CStr(ir)
'Debug.Print("Plot ir=" & CStr(ir))
Next
moffX = 0
moffY = 0
'Debug.Print("plotEnd=" & CStr(sw.ElapsedMilliseconds))
TextBox6.Text = "PlotEnd"
End If
End Sub
'MouseCLICKでステップ動作
Private Sub Form1_MouseDown(sender As Object, e As MouseEventArgs) Handles Me.MouseDown
mClick = 1
'Label14.Text = CStr(mClick)
End Sub
Private Sub Form1_MouseUp(sender As Object, e As MouseEventArgs) Handles Me.MouseUp
mClick = 0
'Label14.Text = CStr(mClick)
End Sub
'手動モーション位置マウスクリック指定---------------------------------------------------------------
'Private Sub dgv1_CellClick(sender As Object, e As DataGridViewCellEventArgs) Handles dgv1.CellClick
' If zsetFlag = 1 Then
' plotrowN = dgv1.CurrentCell.RowIndex
' Label4.Text = plotrowN + 1
' plotC(plotrowN)
' End If
'End Sub
'センタリングボタン　RealTImeMode:現在セル位置をスタート座標とする rePlayMode：指定範囲の平均値----------------------------
Private Sub Button7_Click(sender As Object, e As EventArgs) Handles Button7.Click
Debug.Print("Button7_Clicked")
centering()
End Sub
Private Sub centering()
Dim rPstN As Integer = Int(TextBox4.Text)
Dim rPendN As Integer = Int(TextBox5.Text)
Dim rSize As Integer = rPendN - rPstN
Dim ip As Integer
If rSize > 1 Then
ReDim lonArry(rSize), latiArry(rSize), heightArry(rSize)
ReDim relNArry(rSize), relEArry(rSize), relDarry(rSize)
ReDim lonrArry(rSize), latirArry(rSize), heightrArry(rSize)
For ip = 0 To rSize
lonArry(ip) = (dgv1.Rows(ip + rPstN).Cells(col_lon).Value) Mod 10000000
latiArry(ip) = (dgv1.Rows(ip + rPstN).Cells(col_lati).Value) Mod 10000000
heightArry(ip) = (dgv1.Rows(ip + rPstN).Cells(col_height).Value) Mod 10000000
relNArry(ip) = dgv1.Rows(ip + rPstN).Cells(col_N).Value
relEArry(ip) = dgv1.Rows(ip + rPstN).Cells(col_E).Value
relDarry(ip) = dgv1.Rows(ip + rPstN).Cells(col_D).Value
lonrArry(ip) = lonArry(ip) + relEArry(ip) * RBset
latirArry(ip) = latiArry(ip) + relNArry(ip) * RBset
'NewMethod(rPstN, ip)
Debug.Print(CStr(ip + rPstN) + ":lonr=" & CStr(lonrArry(ip) & "latir=" & CStr(latirArry(ip))))
Debug.Print(CStr(ip + rPstN) + ":relE=" & CStr(relEArry(ip) & "relN=" & CStr(relNArry(ip))))
Next
'lon Max Min Ave
Maxlon = lonArry.Max
Maxrlon = lonrArry.Max
Maxlon = Math.Max(Maxlon, Maxrlon)
Minlon = lonArry.Min
Minrlon = lonrArry.Min
Minlon = Math.Min(Minlon, Minrlon)
Avelon = Int((Maxlon + Minlon) / 2)
'Label17.Text = "Maxlon=" & CStr(Maxlon) & "wmax=" & CStr(Maxlon - Avelon)
'Label18.Text = "Minlon=" & CStr(Minlon) & "wmin=" & CStr(Avelon - Minlon)
'Label19.Text = "zLon=Avelon=" & CStr(Avelon)
'lati Max Min Ave
Maxlati = latiArry.Max
Maxrlati = latirArry.Max
Maxlati = Math.Max(Maxlati, Maxrlati)
Minlati = latiArry.Min
Minrlati = latirArry.Min
Minlati = Math.Min(Minlati, Minrlati)
Avelati = Int((Maxlati + Minlati) / 2)
'Label20.Text = "Maxlati=" & CStr(Maxlati) & "wmax=" & CStr(Maxlati - Avelati)
'Label22.Text = "Minlati=" & CStr(Minlati) & "wmin=" & CStr(Avelati - Minlati)
'Label23.Text = "zLAt=Avelati=" & CStr(Avelati)
zLon = Avelon
zLat = Avelati
End If
' scale計算
lonratio = xsize / (Maxlon - Minlon) 'dot/cm 全X幅をLon全幅とするスケール値
latiratio = ysize / (Maxlati - Minlati) 'dot/cm全Y高さをLati全高さとするスケール値
If lonratio > latiratio Then
rScale = latiratio
Else
rScale = lonratio
End If
If rScale > 10 Then
rScale = 10
End If
Debug.Print("Centerng:Maxlon=" + CStr(Maxlon) + "Minlon=" + CStr(Minlon) + "Maxlati=" + CStr(Maxlati) + "Minlati=" + CStr(Minlati))
Debug.Print("Avelon=" + CStr(Avelon) + "Avelati=" + CStr(Avelati) + "rScale=" + CStr(rScale) + "dot/cm")
' If NVC > 0 Then
' startrowN = NVC - 1 'dgv1.CurrentCell.RowIndex
' zLon = dgv1.Rows(startrowN).Cells(col_lon).Value '基準Long
' zLat = dgv1.Rows(startrowN).Cells(col_lati).Value '基準Lati
' zHeight = dgv1.Rows(startrowN).Cells(col_height).Value '基準Lati
' zRelN = dgv1.Rows(startrowN).Cells(col_N).Value '基準relN
' zRelE = dgv1.Rows(startrowN).Cells(col_E).Value '基準Lati
' zRelD = dgv1.Rows(startrowN).Cells(col_D).Value '基準Lati
' TextBox3.Text = startrowN + 1 '行ヘッダー番号に合わせると＋１
' zsetFlag = 1
' End If
End Sub
Private Sub NewMethod(rPstN As Integer, ip As Integer)
heightrArry(ip) = heightArry(ip) + relDarry(i)
Debug.Print(CStr(ip + rPstN) + ":lon=" & CStr(lonArry(ip) & "lati=" & CStr(latiArry(ip))))
End Sub
'GraphPlotチェックボックスを変化させたときの処理-------------------------------------------------------
Private Sub CheckBox2_CheckedChanged(sender As Object, e As EventArgs) Handles CheckBox2.CheckedChanged
If CheckBox2.Checked = True Then
'Select paramenters with ColumnNo
'Plot data Column mode 0:Simple 1:All header Checking
If dgv1.Columns(4).HeaderText = "lon" Then 'Simple mode=RealTIme ,dgv File
col_lon = 4
col_lati = 5
col_height = 6
col_N = 13
col_E = 14
col_D = 15
col_Len = 16
Label12.Text = "Simple"
End If
If dgv1.Columns(15).HeaderText = "lon" Then 'All mode=MB LOG FILE
col_lon = 15
col_lati = 16
col_height = 17
col_N = 35
col_E = 36
col_D = 37
col_Len = 38
Label12.Text = "All"
'2nd File mode
'If CheckBox11.Checked = True Then
col2_lon = 65
col2_lati = 66
col2_height = 67
col2_N = 85
col2_E = 86
col2_D = 87
col2_Len = 88
Label12.Text = "2ndAll"
'End If
End If
'-------------------Auto Header Detection-------------------------------------------------------
' If dgv1.ColumnCount < 176 Then '1st File Only
For i = 0 To dgv1.ColumnCount - 1
If dgv1.Columns(i).HeaderText = "lon" And i < 49 Then '1st File Only
col_lon = i 'default i=15
col_lati = 1 + i
col_height = 2 + i
col_N = 20 + i
col_E = 21 + i
col_D = 22 + i
col_Len = 23 + i
End If
If dgv1.Columns(i).HeaderText = "lon" And i > 48 Then '1st File Only
col2_lon = i 'default i=65
col2_lati = 1 + i
col2_height = 2 + i
col2_N = 20 + i
col2_E = 21 + i
col2_D = 22 + i
col2_Len = 23 + i
Exit For
End If
Next
'End If
'----------------------------------------------------------------------------------------------
dumLon = col_lon
dumLati = col_lati
dumN = col_N
dumE = col_E
dumD = col_D
PictureBox1.Visible = True
centering()
plotC(plotrowN)
End If
'If CheckBox2.Checked = False Then
' PictureBox1.Visible = False
'End If
End Sub
'=========================Graph image Clear===================================
Private Sub Button6_Click(sender As Object, e As EventArgs) Handles Button6.Click
mouseFlag = 0
ClearImage()
End Sub
Sub ClearImage()
PictureBox1.Image = Nothing
'CLear時に軸罫線を描く
If CheckBox7.Checked = True Then 'SecondFlag = 2 And clearFlag = 1 Then 'Draw Graph Axis
PictureBox1.Image = New Bitmap(xsize, ysize)
Dim g As Graphics = Graphics.FromImage(PictureBox1.Image)
Dim axisdiv = 40 'dot/div
Dim div_yAxis As Integer = Int(ysize / axisdiv)
Dim div_xAxis As Integer = Int(xsize / axisdiv)
Dim BPen As New Pen(Color.Gray, 0.2) 'ラインの色・ラインの太さを設定
g.FillRectangle(Brushes.Black, 0, 0, xsize, ysize)
If CheckBox15.Checked = True Then
For i = 1 To div_xAxis - 1 'Yjiku平行線 本数
Dim pty1 As New Point(axisdiv * i, ysize) 'ラインの描画開始地点
Dim pty2 As New Point(axisdiv * i, 0)
g.DrawLine(BPen, pty1, pty2) 'xAxisに平行ラインを描画
Next i
For j = 1 To div_yAxis - 1 'Xjiku平行線　本数
'BPen.EndCap = Drawing2D.LineCap.ArrowAnchor 'ラインの先端を矢印に
'ラインの描画終了地点
Dim ptx1 As New Point(xsize, axisdiv * j) 'ラインの描画開始地点
Dim ptx2 As New Point(0, axisdiv * j) 'ラインの描画終了地点
g.DrawLine(BPen, ptx1, ptx2) 'yAxisに平行ラインを描画
Next j
End If
SecondFlag = 0
BPen.Dispose()
g.Dispose()
'clearFlag = 0
End If
clearFlag += 1
End Sub
'*******************************************************************PlotC()***********************************************************************************************
'==================================================================================================================================================================================
'plotC():Graph Draw処理
'=================================================================================================================================================================================
Sub plotC(ByVal rN As Integer) 'ByVal dataNo As Integer, ByVal value As Integer, ByVal value_1 As Integer, ByVal colorN As Integer)
Dim i, j, k As Integer
'Dim xsize As Integer = 1200
'Dim ysize As Integer = 400
Try
Dim xCenter As Integer = xsize / 2
Dim yCenter As Integer = ysize / 2
If clearFlag = 0 Then
ClearImage()
End If
If PictureBox1.Image Is Nothing Then '初回だけＢＩＴＭＡＰを定義する　Picture1.imageという名称をつかうこと
PictureBox1.Image = New Bitmap(xsize, ysize)
SecondFlag = 1
Kbold = 1
End If
Dim g As Graphics = Graphics.FromImage(PictureBox1.Image)
Dim scale As Single
' scale = HScrollBar1.Value / 10
scale = rScale
pcount += 1
'-------------------------------------------------------
Dim rNlon As Integer = (dgv1.Rows(rN).Cells(col_lon).Value) Mod 10000000
Dim rNlat As Integer = (dgv1.Rows(rN).Cells(col_lati).Value) Mod 10000000
Dim rNheight As Integer = (dgv1.Rows(rN).Cells(col_height).Value)
Dim rNrelN As Integer = (dgv1.Rows(rN).Cells(col_N).Value) * RBset
Dim rNrelE As Integer = (dgv1.Rows(rN).Cells(col_E).Value) * RBset
Dim rNrelD As Integer = (dgv1.Rows(rN).Cells(col_D).Value)
'異常値処理
If (rNrelN > 1000 Or rNrelE > 1000 Or rNrelD > 1000) Then
Debug.Print("rN値が大きすぎます" & CStr(rN) & "行目をジャンプします”)
Exit Sub 'Plot Cを抜け出す
End If
'Trace Line
pxb_1 = pxb
pyb_1 = pyb
pxr_1 = pxr
pyr_1 = pyr
If RadioButton6.Checked = True Then
' ************************************平均中心座標***************************************************************
zLon_1 = 0
zLat_1 = 0
pxb = (CInt((rNlon - (zLon + zLon_1)) * scale) + xCenter + offX) '+ moffX)
pyb = ysize - (CInt((rNlat - (zLat + zLat_1)) * scale) + yCenter + offY) ' - moffY)
pxr = (CInt(((rNlon - (zLon + zLon_1) + rNrelE)) * scale) + xCenter + offX) ' + moffX)' - to + change 2021/2/24
pyr = ysize - (CInt(((rNlat - (zLat + zLat_1) + rNrelN)) * scale) + yCenter + offY) '- moffY)' - to + change 2021/2/24
'*****************************************************************************************************************
End If
If RadioButton7.Checked = True Then
'/////////////////////左下　最小値座標//////////////////////////////////////////////////
pxb = (CInt((rNlon - Minlon) * scale)) + offX - moffX
pyb = ysize - (CInt((rNlat - Minlati) * scale)) + offY - moffY
pxr = (CInt(((rNlon - Minlon + rNrelE)) * scale)) + offX - moffX ' - to + change 2021/2/24
pyr = ysize - (CInt(((rNlat - Minlati + rNrelN))) * scale) + offY - moffY ' - to + change 2021/2/24
'////////////////////////////////////////////////////////////////////////////////////////////
End If
'Debug.Print("pxb=" & CStr(pxb) & "scale=" & CStr(scale) & "offX=" & CStr(offX) & "moffX=" & CStr(moffX))
'Debug.Print("pyb=" & CStr(pyb) & "scale=" & CStr(scale) & "offY=" & CStr(offY) & "moffY=" & CStr(moffY))
Dim p As New Pen(Color.White)
p.Width = 0.1
rSize = Val(TextBox5.Text) - Val(TextBox4.Text)
Debug.Print("In plotc:rSize=" & CStr(rSize) & "mouseFlag=" & CStr(mouseFlag))
If rSize > 2 And mouseFlag = 0 Then
'Mouse用Array Npbx(),Npby,Nprx(),NprY()
Npbx(rN) = pxb
Npby(rN) = pyb
Nprx(rN) = pxr
Npry(rN) = pyr
'Debug.Print("rNo=" & CStr(rN) & ",Npbx=" & CStr(Npbx(rN)) & ",Npby=" & CStr(Npby(rN)) & ",Nprx=" & CStr(Nprx(rN)) & ",Npry=" & CStr(Npry(rN)))
End If
'Debug.Print("g.ellipse rNo=" & CStr(rN) & ",pxb=" & CStr(pxb) & ",pyb=" & CStr(pyb) & ",pxr=" & CStr(pxr) & ",pyr=" & CStr(pyr))
If pxb < xsize And pyb < ysize And pxr < xsize And pyr < ysize And (CheckBox6.Checked = True Or dataReceivedFlag = 1) Then
'Debug.Print("g.ellipse rNo=" & CStr(rN) & ",pxb=" & CStr(pxb) & ",pyb=" & CStr(pyb) & ",pxr=" & CStr(pxr) & ",pyr=" & CStr(pyr))
'Plot Point-------------------------------------------
g.FillEllipse(Brushes.LawnGreen, pxb, pyb, 3, 3)
g.FillEllipse(Brushes.Red, pxr, pyr, 4, 4)
'-----------------------------------------------------
If CheckBox3.Checked = True Then
p.Color = Color.Red
If delFlag = 1 Then ' delBold() Call
p.Color = Color.Black
End If
p.Width = Kbold
g.DrawLine(p, pxb, pyb, pxr, pyr)
End If
If CheckBox9.Checked = True And pcount > 2 Then
p.Color = Color.LawnGreen
If delFlag = 1 Then ' delBold() Call
p.Color = Color.Black
End If
p.Width = Kbold
g.DrawLine(p, pxb, pyb, pxb_1, pyb_1)
p.Color = Color.Red
g.DrawLine(p, pxr, pyr, pxr_1, pyr_1)
End If
End If
'==============================Text Display ========================================================================
Dim tx0 As Integer = 0
Dim ty0 As Integer = 520 '40dot/Mempri
'Fill BlackTextArea
p.Color = Color.Black
g.FillRectangle(Brushes.Black, tx0, ty0 - 20, 400, 400)
'Add Speed Head Slip
Dim fnt As New Font("MS UI Gothic", 12)
g.DrawString(" Speed HeadAng SkiAng SlipAng ", fnt, Brushes.White, tx0 + 18, ty0)
Dim fntR As New Font("MS UI Gothic", 16)
'ITow Time Display--------------------------------------------------------------------------------------------
monthN = dgv1.Rows(rN).Cells(col_lon - 12).Value
dayN = dgv1.Rows(rN).Cells(col_lon - 11).Value
hourN = dgv1.Rows(rN).Cells(col_lon - 10).Value + 9 'JST
minN = dgv1.Rows(rN).Cells(col_lon - 9).Value
secN = dgv1.Rows(rN).Cells(col_lon - 8).Value
itowN = dgv1.Rows(rN).Cells(col_lon - 14).Value
msecN = itowN Mod 1000
Dim itowStr As String = CStr(monthN) + "/" + CStr(dayN) + "/" + CStr(hourN) + ": " + CStr(minN) + ": " + CStr(secN) + "sec " + CStr(msecN) + "msec" + " [No." + CStr(rN) + "]"
Dim fntT As New Font("MS UI Gothic", 14)
g.DrawString(itowStr, fntT, Brushes.Cyan, tx0 + 8, ty0 + 55)
'Timer Count Display-----------------------------------------------------------------------------------------------------------------
'totalmsecは、ゼロリセット時刻からのmsec経過時間
Dim totalmsec As Integer = (minN * 60000 + secN * 1000 + msecN) - (min0 * 60000 + sec0 * 1000 + msec0)
Dim zmin As Integer = Int(totalmsec / 60000)
Dim zsec As Integer = Int((totalmsec - zmin * 60000) / 1000)
Dim zmsec As Integer = (totalmsec - zmin * 60000 - zsec * 1000) Mod 1000
Dim timerStr As String = "No[" + CStr(rN0) + "-" + CStr(rN) + "]:" + CStr(zmin) + "min" + CStr(zsec) + "sec" + CStr(zmsec) + "msec"
Dim fntZ As New Font("MS UI Gothic", 16)
g.DrawString(timerStr, fntZ, Brushes.Yellow, tx0 + 8, ty0 - 20)
'*************動画同期コマ送りモード　時間をみて命令する************************
If CheckBox16.Checked = True And Hsc4 = 1 Then 'AsynchroチェックボックスとHscrollbar4にマウスがあるときのみコマ送り
Dim komaRN As Integer = Int(totalmsec / 41.42857) + koma0 '/ 33.367
koma(komaRN)
End If
'*************************************************
'Right Ski Prameters--------------------------------------------------------------------------------------------------------------
'Dim speedR As String = Format((dgv1.Rows(rN).Cells(col_lon + 9).Value * 0.0036), "##.0") + "kmh"
'Dim headR As String = Format((dgv1.Rows(rN).Cells(col_lon + 10).Value * 0.00001), "000") + "deg"
Dim skiHead As Double
Dim speedR As Double = (dgv1.Rows(rN).Cells(col_lon + 9).Value * 0.0036)
Dim speedRF As String = Format(speedR, "##.0") + "kmh"
Dim headR As Double = (dgv1.Rows(rN).Cells(col_lon + 10).Value * 0.00001)
Dim headRF As String = Format(headR, "000") + "deg"
If CheckBox12.Checked = False Then
skiHead = 180
Else
skiHead = 0
End If
'Dim skiR As String = Format((dgv1.Rows(rN).Cells(col_lon + 24).Value * 0.00001) - skiHead, "000") + "deg"
Dim skiR As Double = (dgv1.Rows(rN).Cells(col_lon + 24).Value * 0.00001) - skiHead
Dim skiRF As String = Format(skiR, "000") + "deg"
'Dim slipR As String = Format((dgv1.Rows(rN).Cells(col_lon + 10).Value - dgv1.Rows(rN).Cells(col_lon + 24).Value) * 0.00001 - skiHead, "00") + "deg"
Dim slipR As Double = headR - skiR
Dim slipRF As String = Format(slipR, "00") + "deg"
g.DrawString("Rski=" + speedRF + " " + headRF + " " + skiRF + " " + slipRF, fntR, Brushes.Red, tx0 + 8, ty0 + 14)
'Left Ski--------------------------------------------------------------------------------------------------------------
If CheckBox11.Checked = True Then '2nd File Columns exist
'Dim speedL, headL, skiL, slipL As Double
'Dim speedL As String = Format((dgv1.Rows(rN).Cells(col2_lon + 9).Value * 0.0036), "##.0") + "kmh"
speedL = (dgv1.Rows(rN).Cells(col2_lon + 9).Value * 0.0036)
Dim speedLF As String = Format(speedL, "##.0") + "km/h"
'Dim headL As String = Format((dgv1.Rows(rN).Cells(col2_lon + 10).Value * 0.00001), "000") + "deg"
headL = (dgv1.Rows(rN).Cells(col2_lon + 10).Value * 0.00001)
Dim headLf As String = Format(headL, "000") + "deg"
'Dim skiL As String = Format((dgv1.Rows(rN).Cells(col2_lon + 24).Value * 0.00001) - skiHead, "000") + "deg"
skiL = (dgv1.Rows(rN).Cells(col2_lon + 24).Value * 0.00001) - skiHead
Dim skiLF As String = Format(skiL, "000") + "deg"
'Dim slipL As String = Format(dgv1.Rows(rN).Cells(col2_lon + 10).Value * 0.00001 - (dgv1.Rows(rN).Cells(col2_lon + 24).Value * 0.00001 - 180), "00") + "deg"
slipL = headL - skiL
Dim slipLF As String = Format(slipL, "00") + "deg"
g.DrawString("Lski=" + speedLF + " " + headLf + " " + skiLF + " " + slipLF, fntR, Brushes.LawnGreen, tx0 + 8, ty0 + 34)
End If
'====================================================================================================================
'==============================Vector Meter 2案===================================================================================
If CheckBox11.Checked = True Then '2nd File Columns exist
'Fill Black---------------------------------------
p.Color = Color.Black
g.FillRectangle(Brushes.Black, 400, 400, 400, 400)
'--------------------------------------------------
'Vector Meter グラフ升目-------------------------------------------------------------------------
Dim fntm As New Font("MS UI Gothic", 12)
Dim mesStr As String = "RED:RightSki Green:LeftSki 20cmx20cm AntDis=66cm"
g.DrawString(mesStr, fntm, Brushes.OrangeRed, 400, 380)
Dim VmeterX As Integer = 400
Dim VmeterY As Integer = 400
Dim Vxsize As Integer = 400
Dim Vysize As Integer = 400
Dim Vaxisdiv = 20 'dot/div
Dim Vdiv_yAxis As Integer = Int(Vysize / Vaxisdiv)
Dim Vdiv_xAxis As Integer = Int(Vxsize / Vaxisdiv)
p.Color = Color.OrangeRed
p.Width = 1
For i = 0 To Vdiv_xAxis 'Yjiku平行線 本数
Dim Vpty1 As New Point(Vaxisdiv * i + VmeterX, Vysize + 400) 'ラインの描画開始地点
Dim Vpty2 As New Point(Vaxisdiv * i + VmeterX, Vysize)
g.DrawLine(p, Vpty1, Vpty2) 'xAxisに平行ラインを描画
Next i
For j = 0 To Vdiv_yAxis 'Xjiku平行線　本数
'BPen.EndCap = Drawing2D.LineCap.ArrowAnchor 'ラインの先端を矢印に
'ラインの描画終了地点
Dim Vptx1 As New Point(Vxsize, Vaxisdiv * j + VmeterY) 'ラインの描画開始地点
Dim Vptx2 As New Point(Vxsize + 400, Vaxisdiv * j + VmeterY) 'ラインの描画終了地点
g.DrawLine(p, Vptx1, Vptx2) 'yAxisに平行ラインを描画
Next j
'-------------------------------------------------------------------------------------------------
Dim Ax0 As Integer = 600
Dim Ay0 As Integer = 500
Dim vwidth As Integer = 400
Dim vheight As Integer = 400
'Dim Axb1, Ayb1, Axr1, Ayr1, Axb2, Ayb2, Axr2, Ayr2 As Integer
'Dim Apx0, Apy0 As Integer
'Right ski parameters
'Dim ANlon1, ANlat1, ANheight1, ANrelN1, ANrelE1, ANrelD1 As Integer
'Dim ANlon2, ANlat2, ANheight2, ANrelN2, ANrelE2, ANrelD2 As Integer
'RightSki 1個手前保持
ANlon1_1 = ANlon1
ANlat1_1 = ANlat1
ANheight1_1 = ANheight1
ANrelN1_1 = ANrelN1
ANrelE1_1 = ANrelE1
ANrelD1_1 = ANrelD1
'----------------------
ANlon1 = (dgv1.Rows(rN).Cells(col_lon).Value) Mod 10000 '999cm単位
ANlat1 = (dgv1.Rows(rN).Cells(col_lati).Value) Mod 10000 '999cm単位
ANheight1 = (dgv1.Rows(rN).Cells(col_height).Value)
ANrelN1 = (dgv1.Rows(rN).Cells(col_N).Value) * RBset
ANrelE1 = (dgv1.Rows(rN).Cells(col_E).Value) * RBset
ANrelD1 = (dgv1.Rows(rN).Cells(col_D).Value)
'Left ski parameters
'LeftSki１個手前保持
ANlon2_1 = ANlon2
ANlat2_1 = ANlat2
ANheight2_1 = ANheight2
ANrelN2_1 = ANrelN2
ANrelE2_1 = ANrelE2
ANrelD2_1 = ANrelD2
'---------------------
ANlon2 = (dgv1.Rows(rN).Cells(col2_lon).Value) Mod 10000 '999cm単位
ANlat2 = (dgv1.Rows(rN).Cells(col2_lati).Value) Mod 10000 '999cm単位
ANheight2 = (dgv1.Rows(rN).Cells(col2_height).Value)
ANrelN2 = (dgv1.Rows(rN).Cells(col2_N).Value) * RBset
ANrelE2 = (dgv1.Rows(rN).Cells(col2_E).Value) * RBset
ANrelD2 = (dgv1.Rows(rN).Cells(col2_D).Value)
'MAX MIN ----------------------------------
Dim xMax0, yMax0, xMin0, yMin0 As Integer
Dim xMax1, yMax1, xMin1, yMin1 As Integer
Dim xMax2, yMax2, xMin2, yMin2 As Integer
xMax1 = Math.Max(ANlon1, ANlon1 + ANrelE1)
yMax1 = Math.Max(ANlat1, ANlat1 + ANrelN1)
xMin1 = Math.Min(ANlon1, ANlon1 + ANrelE1)
yMin1 = Math.Min(ANlat1, ANlat1 + ANrelN1)
xMax2 = Math.Max(ANlon2, ANlon2 + ANrelE2)
yMax2 = Math.Max(ANlat2, ANlat2 + ANrelN2)
xMin2 = Math.Min(ANlon2, ANlon2 + ANrelE2)
yMin2 = Math.Min(ANlat2, ANlat2 + ANrelN2)
'result
xMax0 = Math.Max(xMax1, xMax2)
yMax0 = Math.Max(yMax1, yMax2)
xMin0 = Math.Min(xMin1, xMin2)
yMin0 = Math.Min(yMin1, yMin2)
'Ski center lon lat
Apx0_1 = Apx0
Apy0_1 = Apy0
Apx0 = Int((xMax0 + xMin0) / 2)
Apy0 = Int((yMax0 + yMin0) / 2)
'1個前のデータを現在座標で計算
Axb1_1 = ANlon1_1 - Apx0 + Ax0
Axr1_1 = ANlon1_1 + ANrelE1_1 - Apx0 + Ax0
Ayb1_1 = ysize - (ANlat1_1 - Apy0) - 100
Ayr1_1 = ysize - (ANlat1_1 + ANrelN1_1 - Apy0) - 100
Axb2_1 = ANlon2_1 - Apx0 + Ax0
Axr2_1 = ANlon2_1 + ANrelE2_1 - Apx0 + Ax0
Ayb2_1 = ysize - (ANlat2_1 - Apy0) - 100
Ayr2_1 = ysize - (ANlat2_1 + ANrelN2_1 - Apy0) - 100
'Calc xyplot -----------------------------------------
Axb1 = ANlon1 - Apx0 + Ax0
Axr1 = ANlon1 + ANrelE1 - Apx0 + Ax0
Ayb1 = ysize - (ANlat1 - Apy0) - 100
Ayr1 = ysize - (ANlat1 + ANrelN1 - Apy0) - 100
Axb2 = ANlon2 - Apx0 + Ax0
Axr2 = ANlon2 + ANrelE2 - Apx0 + Ax0
Ayb2 = ysize - (ANlat2 - Apy0) - 100
Ayr2 = ysize - (ANlat2 + ANrelN2 - Apy0) - 100
'--------------------------------------------------
Debug.Print("rN:Axb1,Axr1,Axb2,Axr2=" & CStr(rN) & ":" & CStr(Axb1) & "," & CStr(Axr1) & "," & CStr(Axb2) & "," & CStr(Axr2))
Debug.Print("rN:Ayb2,Ayr2,Ayb2,Ayr2=" & CStr(rN) & ":" & CStr(Ayb1) & "," & CStr(Ayr1) & "," & CStr(Ayb2) & "," & CStr(Ayr2))
Debug.Print("xMax0,xMin0,yMax0,yMin0=" & CStr(xMax0) & "," & CStr(xMin0) & "," & CStr(yMax0) & "," & CStr(yMin0))
'If xMax0 < 600 And xMin0 > 400 And yMax0 < 200 And yMin0 > 0 Then'はみ出し防止
'Plot RSki----------------------------------
p.Color = Color.Red
p.Width = 6 'Kbold
If (Axb1 < 900 And Axb1 > 400 And Ayb1 < 800 And Ayb1 > 400) And (Axr1 < 900 And Axr1 > 400 And Ayr1 < 800 And Ayr1 > 400) Then 'はみ出し防止 Then 'はみ出し防止
g.DrawLine(p, Axb1, Ayb1, Axr1, Ayr1)
End If
p.Width = 2 'Kbold
If (Axb1_1 < 900 And Axb1_1 > 400 And Ayb1_1 < 800 And Ayb1_1 > 400) And (Axr1_1 < 900 And Axr1_1 > 400 And Ayr1_1 < 800 And Ayr1_1 > 400) Then 'はみ出し防止
g.DrawLine(p, Axb1_1, Ayb1_1, Axr1_1, Ayr1_1)
End If
'Plot LSki----------------------------------
p.Color = Color.LawnGreen
p.Width = 6 'Kbold
If (Axb2 < 900 And Axb2 > 400 And Ayb2 < 800 And Ayb2 > 400) And (Axr2 < 900 And Axr2 > 400 And Ayr2 < 800 And Ayr2 > 400) Then 'はみ出し防止 Then 'はみ出し防止
g.DrawLine(p, Axb2, Ayb2, Axr2, Ayr2)
End If 'はみ出し防止
p.Width = 2 'Kbold
If (Axb2_1 < 900 And Axb2_1 > 400 And Ayb2_1 < 800 And Ayb2_1 > 400) And (Axr2_1 < 900 And Axr2_1 > 400 And Ayr2_1 < 800 And Ayr2_1 > 400) Then 'はみ出し防止
g.DrawLine(p, Axb2_1, Ayb2_1, Axr2_1, Ayr2_1)
End If 'はみ出し防止
'-----------------------------------------------------------------------
'Vector Arrow Add---------------------------------------------------
'Right Vector Angle =headR at base point start
Dim Alength As Double = 40 '20cm
Dim RarrowX, RarrowY As Integer
RarrowX = Int(Alength * Math.Sin(0.0174532 * headR) + Axb1)
RarrowY = Int(-Alength * Math.Cos(0.0174532 * headR) + Ayb1)
p.Color = Color.White
p.Width = 5 'Kbold
p.EndCap = System.Drawing.Drawing2D.LineCap.ArrowAnchor
g.DrawLine(p, Axb1, Ayb1, RarrowX, RarrowY)
'Left Vector Angle =headL at base point start
'Dim Alength As Double = 40 '20cm
Dim LarrowX, LarrowY As Integer
LarrowX = Int(Alength * Math.Sin(0.0174532 * headL) + Axb2)
LarrowY = Int(-Alength * Math.Cos(0.0174532 * headL) + Ayb2)
p.Color = Color.White
p.Width = 5 'Kbold
p.EndCap = System.Drawing.Drawing2D.LineCap.ArrowAnchor
g.DrawLine(p, Axb2, Ayb2, LarrowX, LarrowY)
End If 'checkbox11
'============================================================================================================================
''============================================================================================================================
'Label5.Text = "pxb=" & CStr(pxb)
'Label6.Text = "pyb=" & CStr(pyb)
'Label7.Text = "pxr=" & CStr(pxr)
'Label8.Text = "pyr=" & CStr(pyr)
'g.Dispose()' Disposeだとプロットされない
PictureBox1.Refresh()
'b.Dispose()
' PictureBox1.Invalidate()
'Error catch
Catch ex As System.IO.FileNotFoundException
'FileNotFoundExceptionをキャッチした時
Debug.Print("エラーが" & CStr(rN) & "行で発生しました”）
Debug.Print(ex.Message)
End Try
End Sub ' plotC end
'*********************************************************************************************************************************************************************************
'=================================================================================================================================================================================
'2nd File plotC2():Graph Draw処理
'=================================================================================================================================================================================
Sub plotC2(ByVal rN As Integer) 'ByVal dataNo As Integer, ByVal value As Integer, ByVal value_1 As Integer, ByVal colorN As Integer)
Dim i, j, k As Integer
'Dim xsize As Integer = 1200
'Dim ysize As Integer = 400
Try
Dim xCenter As Integer = xsize / 2
Dim yCenter As Integer = ysize / 2
'If clearFlag = 0 Then
' ClearImage()
'End If
'If PictureBox1.Image Is Nothing Then '初回だけＢＩＴＭＡＰを定義する　Picture1.imageという名称をつかうこと
' PictureBox1.Image = New Bitmap(xsize, ysize)
' SecondFlag = 1
'End If
Dim g As Graphics = Graphics.FromImage(PictureBox1.Image)
Dim scale As Single
' scale = HScrollBar1.Value / 10
scale = rScale
pcount += 1
'-------------------------------------------------------
Dim rNlon As Integer = (dgv1.Rows(rN).Cells(col2_lon).Value) Mod 10000000
Dim rNlat As Integer = (dgv1.Rows(rN).Cells(col2_lati).Value) Mod 10000000
Dim rNheight As Integer = (dgv1.Rows(rN).Cells(col2_height).Value)
Dim rNrelN As Integer = (dgv1.Rows(rN).Cells(col2_N).Value) * RBset
Dim rNrelE As Integer = (dgv1.Rows(rN).Cells(col2_E).Value) * RBset
Dim rNrelD As Integer = (dgv1.Rows(rN).Cells(col2_D).Value)
'異常値処理
If (rNrelN > 1000 Or rNrelE > 1000 Or rNrelD > 1000) Then
Debug.Print("rN値が大きすぎます" & CStr(rN) & "行目をジャンプします”)
Exit Sub 'Plot Cを抜け出す
End If
'Trace Line
pxb_1 = pxb
pyb_1 = pyb
pxr_1 = pxr
pyr_1 = pyr
If RadioButton6.Checked = True Then
' ************************************平均中心座標***************************************************************
zLon_1 = 0
zLat_1 = 0
pxb = (CInt((rNlon - (zLon + zLon_1)) * scale) + xCenter + offX) '+ moffX)
pyb = ysize - (CInt((rNlat - (zLat + zLat_1)) * scale) + yCenter + offY) ' - moffY)
pxr = (CInt(((rNlon - (zLon + zLon_1) + rNrelE)) * scale) + xCenter + offX) ' + moffX)<<< - to + change 2021/2/24>>>
pyr = ysize - (CInt(((rNlat - (zLat + zLat_1) + rNrelN)) * scale) + yCenter + offY) '- moffY)<<< - to + change 2021/2/24>>>
'*****************************************************************************************************************
End If
If RadioButton7.Checked = True Then
'/////////////////////左下　最小値座標//////////////////////////////////////////////////
pxb = (CInt((rNlon - Minlon) * scale)) + offX - moffX
pyb = ysize - (CInt((rNlat - Minlati) * scale)) + offY - moffY
pxr = (CInt(((rNlon - Minlon - rNrelE)) * scale)) + offX - moffX
pyr = ysize - (CInt(((rNlat - Minlati - rNrelN))) * scale) + offY - moffY
'////////////////////////////////////////////////////////////////////////////////////////////
End If
'Debug.Print("pxb=" & CStr(pxb) & "scale=" & CStr(scale) & "offX=" & CStr(offX) & "moffX=" & CStr(moffX))
'Debug.Print("pyb=" & CStr(pyb) & "scale=" & CStr(scale) & "offY=" & CStr(offY) & "moffY=" & CStr(moffY))
Dim p As New Pen(Color.Blue)
p.Width = 0.1
'If rSize > 2 Then
' 'Mouse用Array Npbx(),Npby,Nprx(),NprY()
' Npbx(rN) = pxb
' Npby(rN) = pyb
' Nprx(rN) = pxr
' Npry(rN) = pyr
' 'Debug.Print("rNo=" & CStr(rN) & ",Npbx=" & CStr(Npbx(rN)) & ",Npby=" & CStr(Npby(rN)) & ",Nprx=" & CStr(Nprx(rN)) & ",Npry=" & CStr(Npry(rN)))
'End If
'Debug.Print("g.ellipse rNo=" & CStr(rN) & ",pxb=" & CStr(pxb) & ",pyb=" & CStr(pyb) & ",pxr=" & CStr(pxr) & ",pyr=" & CStr(pyr))
If pxb < xsize And pyb < ysize And pxr < xsize And pyr < ysize And (CheckBox6.Checked = True Or dataReceivedFlag = 1) Then
'Debug.Print("g.ellipse rNo=" & CStr(rN) & ",pxb=" & CStr(pxb) & ",pyb=" & CStr(pyb) & ",pxr=" & CStr(pxr) & ",pyr=" & CStr(pyr))
g.FillEllipse(Brushes.Aqua, pxb, pyb, 3, 3)
g.FillEllipse(Brushes.Yellow, pxr, pyr, 4, 4)
If CheckBox3.Checked = True Then
p.Color = Color.LawnGreen
If delFlag = 1 Then ' delBold() Call
p.Color = Color.Black
End If
p.Width = Kbold
g.DrawLine(p, pxb, pyb, pxr, pyr)
End If
If CheckBox9.Checked = True And pcount > 2 Then
p.Color = Color.LawnGreen
If delFlag = 1 Then ' delBold() Call
p.Color = Color.Black
End If
p.Width = Kbold
g.DrawLine(p, pxb, pyb, pxb_1, pyb_1)
p.Color = Color.Red
g.DrawLine(p, pxr, pyr, pxr_1, pyr_1)
End If
End If
Label5.Text = "pxb=" & CStr(pxb)
Label6.Text = "pyb=" & CStr(pyb)
Label7.Text = "pxr=" & CStr(pxr)
Label8.Text = "pyr=" & CStr(pyr)
'g.Dispose()' Disposeだとプロットされない
PictureBox1.Refresh()
'b.Dispose()
' PictureBox1.Invalidate()
'Error catch
Catch ex As System.IO.FileNotFoundException
'FileNotFoundExceptionをキャッチした時
Debug.Print("エラーが" & CStr(rN) & "行で発生しました”）
Debug.Print(ex.Message)
End Try
End Sub ' plotC end
'マウスクリックしてdgv1現在位置表示
Private Sub dgv1_MouseClick(sender As Object, e As MouseEventArgs) Handles dgv1.MouseClick
Dim maxselRow As Integer = 0
Dim minselRow As Integer = 0
Dim icount As Integer
Dim crN As Integer = dgv1.CurrentCell.RowIndex
Dim ccN As Integer = dgv1.CurrentCell.ColumnIndex
Label9.Text = "Row,Col=" & CStr(crN) & "," & CStr(ccN)
End Sub
'dgv1マウス押してStart値決める
Private Sub dgv1_MouseDown(sender As Object, e As MouseEventArgs) Handles dgv1.MouseDown
If CheckBox6.Checked = True Then
Dim crN As Integer = dgv1.CurrentCell.RowIndex
Dim ccN As Integer = dgv1.CurrentCell.ColumnIndex
TextBox4.Text = crN
End If
End Sub
'dgv1マウス戻してEND値決める
Private Sub dgv1_MouseUp(sender As Object, e As MouseEventArgs) Handles dgv1.MouseUp
If CheckBox6.Checked = True Then
Dim crN As Integer = dgv1.CurrentCell.RowIndex
Dim ccN As Integer = dgv1.CurrentCell.ColumnIndex
TextBox5.Text = crN
End If
End Sub
'rePLAY Modeチェック
Private Sub CheckBox6_CheckedChanged(sender As Object, e As EventArgs) Handles CheckBox6.CheckedChanged
HScrollBar2.Value = 50 'offX=0
VScrollBar1.Value = 50 'offY=0
If CheckBox6.Checked = True Then
Button8.Enabled = True
Button9.Enabled = True
ComboBox2.Enabled = True
End If
End Sub
'======================================================================================
'================================================================
'PictureBox1内でMouseポイントでグラフ座標と指定しているデータNoを得る
'================================================================
'======================================================================================
Private Sub PictureBox1_MouseDown(sender As Object, e As MouseEventArgs) Handles PictureBox1.MouseDown
If CheckBox6.Checked = True Then
Dim xsize As Integer = PictureBox1.Width
Dim ysize As Integer = PictureBox1.Height
'If PictureBox1.Image Is Nothing Then '初回だけＢＩＴＭＡＰを定義する　Picture1.imageという名称をつかうこと
' PictureBox1.Image = New Bitmap(xsize, ysize)
'End If
''PictureBox1.Image = New Bitmap(xsize, ysize)
Dim g As Graphics = Graphics.FromImage(PictureBox1.Image)
Dim kitenX As Integer = PictureBox1.Left
Dim kitenY As Integer = PictureBox1.Top
Label1.Text = "kitenX=" & CStr(kitenX) & ",kitenY=" & CStr(kitenY)
'フォーム上の座標でマウスポインタの位置を取得する
''画面座標でマウスポインタの位置を取得する
Dim sp As System.Drawing.Point = System.Windows.Forms.Cursor.Position
''画面座標をクライアント座標に変換する
Dim cp As System.Drawing.Point = Me.PointToClient(sp) 'Form1の座標がでる
'X座標を取得する
Dim x As Integer = cp.X
'Y座標を取得する
Dim y As Integer = cp.Y
'TextBox1.Text = CStr(x - kitenX) & "," & CStr(y - kitenY)
' Debug.Print(CStr(x - kitenX) & "," & CStr(y - kitenY))
'Label28.Text = "MousePositionX,Y=" & CStr(x - kitenX) & "," & CStr(y - kitenY)
'Debug.Print("MousePositionX,Y=" & CStr(x - kitenX) & "," & CStr(y - kitenY))
'Mouse ポイントオフセット座標
moffX = (x - kitenX)
moffY = (ysize - (y - kitenY)) '左下
'Label27.Text = "moffX,Y=" & CStr(moffX) & "," & CStr(moffY)
'Debug.Print("moffX,Y=" & CStr(moffX) & "," & CStr(moffY))
'Ellipse
Dim p As New Pen(Color.Red)
p.Width = 0.1
sx = CType(x - kitenX, Single)
sy = CType(y - kitenY, Single)
g.FillEllipse(Brushes.White, sx, sy, 10, 10)
' g.DrawRectangle(Brushes.White, sx - 5, sy - 5, sx + 5, sy + 5)
Dim MP_rN As Integer = MPsearch(x - kitenX, y - kitenY)
'Label29.Text = "LEFT-TOP:NP_rN=" & CStr(MP_rN) & "MPsearch X,Y=(" & CStr(Npbx(MP_rN)) & "," & CStr(Npby(MP_rN)) & ")"
TextBox4.Text = CStr(MP_rN)
mouseFlag = 1
'g.FillEllipse(Brushes.Blue, Npbx(MP_rN), Npby(MP_rN), 20, 20)
PictureBox1.Refresh()
'フォーム上の座標 (10, 20) にマウスポインタを移動する
'クライアント座標を画面座標に変換する
Dim mp As System.Drawing.Point =
Me.PointToScreen(New System.Drawing.Point(cp.X, cp.Y))
'マウスポインタの位置を設定する
'System.Windows.Forms.Cursor.Position = mp
End If
End Sub
Private Sub PictureBox1_MouseUp(sender As Object, e As MouseEventArgs) Handles PictureBox1.MouseUp
If CheckBox6.Checked = True Then
Dim xsize As Integer = PictureBox1.Width
Dim ysize As Integer = PictureBox1.Height
'If PictureBox1.Image Is Nothing Then '初回だけＢＩＴＭＡＰを定義する　Picture1.imageという名称をつかうこと
' PictureBox1.Image = New Bitmap(xsize, ysize)
'End If
''PictureBox1.Image = New Bitmap(xsize, ysize)
Dim g As Graphics = Graphics.FromImage(PictureBox1.Image)
Dim kitenX As Integer = PictureBox1.Left
Dim kitenY As Integer = PictureBox1.Top
Label1.Text = "kitenX=" & CStr(kitenX) & ",kitenY=" & CStr(kitenY)
'フォーム上の座標でマウスポインタの位置を取得する
''画面座標でマウスポインタの位置を取得する
Dim sp As System.Drawing.Point = System.Windows.Forms.Cursor.Position
''画面座標をクライアント座標に変換する
Dim cp As System.Drawing.Point = Me.PointToClient(sp) 'Form1の座標がでる
'X座標を取得する
Dim x As Integer = cp.X
'Y座標を取得する
Dim y As Integer = cp.Y
'TextBox1.Text = CStr(x - kitenX) & "," & CStr(y - kitenY)
' Debug.Print(CStr(x - kitenX) & "," & CStr(y - kitenY))
'Label28.Text = "MousePositionX,Y=" & CStr(x - kitenX) & "," & CStr(y - kitenY)
' Debug.Print("MousePositionX,Y=" & CStr(x - kitenX) & "," & CStr(y - kitenY))
'Mouse ポイントオフセット座標
moffX = (x - kitenX)
moffY = (ysize - (y - kitenY)) '左下
'Label27.Text = "moffX,Y=" & CStr(moffX) & "," & CStr(moffY)
'Debug.Print("moffX,Y=" & CStr(moffX) & "," & CStr(moffY))
'Ellipse
Dim p As New Pen(Color.Yellow)
p.Width = 0.1
ex = CType(x - kitenX, Single)
ey = CType(y - kitenY, Single)
'g.FillEllipse(Brushes.White, ex, ey, 10, 10)
mouseFlag = 1 'Mouseサーチモード
Debug.Print("MouseUp mouseFlag=" & CStr(mouseFlag))
g.DrawRectangle(p, sx, sy, Math.Abs(ex - sx), Math.Abs(ey - sy))
Dim MP_rN As Integer = MPsearch(x - kitenX, y - kitenY)
'Label30.Text = "Right-Bottom:NP_rN=" & CStr(MP_rN) & "MPsearch X,Y=(" & CStr(Npbx(MP_rN)) & "," & CStr(Npby(MP_rN)) & ")"
TextBox5.Text = CStr(MP_rN)
'g.FillEllipse(Brushes.Blue, Npbx(MP_rN), Npby(MP_rN), 20, 20)
PictureBox1.Refresh()
'フォーム上の座標 (10, 20) にマウスポインタを移動する
'クライアント座標を画面座標に変換する
Dim mp As System.Drawing.Point =
Me.PointToScreen(New System.Drawing.Point(cp.X, cp.Y))
'マウスポインタの位置を設定する
'System.Windows.Forms.Cursor.Position = mp
End If
End Sub
Function MPsearch(mx As Integer, my As Integer) As Integer
Dim distance As Double = 0
Dim distance_1 As Double
Dim Min_dis As Double
Dim Min_dis_rN As Integer
Dim d2 As Double
'Npbx,Npby,Nrx,Nryの近い座標を探す
Dim rPstN As Integer = Int(TextBox4.Text)
Dim rPendN As Integer = Int(TextBox5.Text)
Dim rSize As Integer = rPendN - rPstN
For i = 0 To rSize - 1
distance_1 = distance
d2 = (mx - Npbx(rPstN + i)) ^ 2 + (my - Npby(rPstN + i)) ^ 2
'Debug.Print("i=" & CStr(i) & "mx=" & CStr(mx) & "Npbx=" & CStr(Npbx(rPstN + i) & "my=" & CStr(my) & "npby=" & CStr(Npby(rPstN + i))))
distance = Math.Sqrt(d2)
'Debug.Print("N=" & CStr(rPstN + i) & "distance=" & CStr(distance))
If distance < Min_dis Or i = 0 Then
Min_dis = distance
Min_dis_rN = i + rPstN
'Debug.Print("MinDistance:N=" & CStr(Min_dis_rN) & "Min_dis=" & CStr(distance))
End If
Next
Return Min_dis_rN
End Function
Private Function Vrscale(vol As Integer) As Double
'hScrolbar max=120 min=0
Select Case vol
Case 110 To 120
Vrscale = 0.35 * (vol - 110) + 4
Case 100 To 110
Vrscale = 0.2 * (vol - 100) + 2
Case 90 To 100
Vrscale = 0.1 * (vol - 90) + 1
Case 80 To 90
Vrscale = 0.02 * (vol - 80) + 0.8
Case 70 To 80
Vrscale = 0.03 * (vol - 70) + 0.5
Case 60 To 70
Vrscale = 0.01 * (vol - 60) + 0.4
Case 50 To 60
Vrscale = 0.015 * (vol - 50) + 0.25
Case 40 To 50
Vrscale = 0.005 * (vol - 40) + 0.2
Case 30 To 40
Vrscale = 0.01 * (vol - 30) + 0.1
Case 20 To 30
Vrscale = 0.005 * (vol - 20) + 0.05
Case 10 To 20
Vrscale = 0.004 * (vol - 10) + 0.01
Case 0 To 10
Vrscale = 0.001 * (vol - 0) + 0
End Select
End Function
'Private Sub HScrollBar1_MouseUp(sender As Object, e As MouseEventArgs) Handles HScrollBar1.MouseUp
' rScale = Vrscale(HScrollBar1.Value)
' TextBox1.Text = rScale 'HScrollBar1.Value
'End Sub
Private Sub HScrollBar1_ValueChanged(sender As Object, e As EventArgs) Handles HScrollBar1.ValueChanged
rScale = Vrscale(HScrollBar1.Value)
Label13.Text = "divsize=" & Int(axisdiv / rScale) & "cm X " & Int(axisdiv / rScale) & "cm"
TextBox1.Text = rScale 'HScrollBar1.Value
End Sub
'グラフ観察モードでスクロールで描く
Private Sub HScrollBar4_ValueChanged(sender As Object, e As EventArgs) Handles HScrollBar4.ValueChanged
Dim maxV, minV As Integer
minV = Val(TextBox4.Text)
maxV = Val(TextBox5.Text)
HScrollBar4.Maximum = maxV + 9
HScrollBar4.Minimum = minV
enN_1 = Val(TextBox7.Text)
Dim targetRN As Integer = HScrollBar4.Value
'*************動画同期コマ送りモード************************
If CheckBox16.Checked = True Then
koma(targetRN)
End If
'*************************************************
TextBox7.Text = targetRN
'rePlay2() '---------Replay until enN
'-------------------BOLD LINE------------------------
delBold(6, enN_1) 'Delete BOLD Black
Bold(1, enN_1) 'Return Width1
Bold(6, targetRN) 'Bold enN LINE
Kbold = 1
'Parameter Dips Textbox RigthSki8-12 LeftSki13-17
'===================RightData (1st FIle)====================================================
'gspeed---------------------------------------------------------------------------------
TextBox8.Text = Format((dgv1.Rows(targetRN).Cells(24).Value * 0.0036), "0.000") + "km/h"
'TextBox13.Text = Format((dgv1.Rows(targetRN).Cells(74).Value * 0.0036), "0.000") + "km/H"
'headMot deg-------------------------------------------------------------------------------
TextBox9.Text = Format((dgv1.Rows(targetRN).Cells(25).Value * 0.00001), "0.00") + "deg"
'TextBox14.Text = Format((dgv1.Rows(targetRN).Cells(75).Value * 0.00001), "0.00") + "deg"
'relPosHeading deg-------------------------------------------------------------------------
TextBox10.Text = Format((dgv1.Rows(targetRN).Cells(39).Value * 0.00001), "0.00") + "deg"
'TextBox15.Text = Format((dgv1.Rows(targetRN).Cells(89).Value * 0.00001) - 180, "0.00") + "deg"
'Slide角　横滑り角＝進行方向ー板方向----------------------------------------------------------------------------------------
Dim slideR As Double = (dgv1.Rows(targetRN).Cells(25).Value - dgv1.Rows(targetRN).Cells(39).Value) * 0.00001
'Dim slideL As Double = dgv1.Rows(targetRN).Cells(75).Value * 0.00001 - (dgv1.Rows(targetRN).Cells(89).Value * 0.00001 - 180)
TextBox11.Text = Format(slideR, "0.00") + "deg"
'TextBox16.Text = Format(slideL, "0.00") + "deg"
'Height (m)---------------------------------------------------------------------
TextBox12.Text = Format(dgv1.Rows(targetRN).Cells(17).Value / 1000, "0.000") + "m"
'TextBox17.Text = Format(dgv1.Rows(targetRN).Cells(67).Value / 1000, "0.000") + "m"
'===================LEdtData (1st FIle)====================================================
If CheckBox11.Checked = True Then
'gspeed---------------------------------------------------------------------------------
'TextBox8.Text = Format((dgv1.Rows(targetRN).Cells(24).Value * 0.0036), "0.000") + "km/h"
TextBox13.Text = Format((dgv1.Rows(targetRN).Cells(74).Value * 0.0036), "0.000") + "km/H"
'headMot deg-------------------------------------------------------------------------------
'TextBox9.Text = Format((dgv1.Rows(targetRN).Cells(25).Value * 0.00001), "0.00") + "deg"
TextBox14.Text = Format((dgv1.Rows(targetRN).Cells(75).Value * 0.00001), "0.00") + "deg"
'relPosHeading deg-------------------------------------------------------------------------
'TextBox10.Text = Format((dgv1.Rows(targetRN).Cells(39).Value * 0.00001), "0.00") + "deg"
TextBox15.Text = Format((dgv1.Rows(targetRN).Cells(89).Value * 0.00001) - 180, "0.00") + "deg"
'Slide角　横滑り角＝進行方向ー板方向----------------------------------------------------------------------------------------
'Dim slideR As Double = (dgv1.Rows(targetRN).Cells(25).Value - dgv1.Rows(targetRN).Cells(39).Value) * 0.00001
Dim slideL As Double = dgv1.Rows(targetRN).Cells(75).Value * 0.00001 - (dgv1.Rows(targetRN).Cells(89).Value * 0.00001 - 180)
' TextBox11.Text = Format(slideR, "0.00") + "deg"
TextBox16.Text = Format(slideL, "0.00") + "deg"
'Height (m)---------------------------------------------------------------------
'TextBox12.Text = Format(dgv1.Rows(targetRN).Cells(17).Value / 1000, "0.000") + "m"
TextBox17.Text = Format(dgv1.Rows(targetRN).Cells(67).Value / 1000, "0.000") + "m"
End If
'
'slope 板の下降傾斜角%　 relPOSD/Length
'Dim RrelPOSD As Integer = dgv1.Rows(targetRN).Cells(37).Value
'Dim RrelLength As Integer = dgv1.Rows(targetRN).Cells(38).Value
''Dim Rslope As Double = Math.Atan(RrelPOSD / RrelLength) * 180 / Math.PI
'Dim Rslope As Double = (RrelPOSD / RrelLength) * 100
'Dim LrelPOSD As Integer = dgv1.Rows(targetRN).Cells(87).Value
'Dim LrelLength As Integer = dgv1.Rows(targetRN).Cells(88).Value
''Dim Lslope As Double = Math.Atan(LrelPOSD / LrelLength) * 180 / Math.PI
'Dim Lslope As Double = (LrelPOSD / LrelLength) * 100
'Height (m)---------------------------------------------------------------------
'TextBox12.Text = Format(dgv1.Rows(targetRN).Cells(17).Value / 1000, "0.000") + "m"
'TextBox17.Text = Format(dgv1.Rows(targetRN).Cells(67).Value / 1000, "0.000") + "m"
End Sub
' rePlay2 はスクロールで自由に描画できるモード
'rePlay2():指定スタート行=TextBox4からエンド行=TextBox7までグラフプロットをリプレイするHscrll4で描画--------------
Private Sub rePlay2() '(startRowN As Integer, endRowN As Integer, speed As Single)
Dim ir As Integer '再生行No
Dim periodT As Integer
Dim periodT_1 As Integer
Dim selPT As Integer
'ComboBox2 wait time read
Dim selI As Integer = ComboBox2.SelectedIndex
selPT = 0
If Int(TextBox4.Text) >= 0 And Int(TextBox7.Text) > 0 Then
' Label14.Text = "PlotStart"
' TextBox6.Text = "PlotStart"
enN_1 = enN
stN = Int(TextBox4.Text)
enN = Int(TextBox7.Text)
'sw.Start()
'Debug.Print("plotstart=" & CStr(sw.ElapsedMilliseconds))
If enN_1 > enN Then
ClearImage()
End If
For ir = stN To enN 'enN
plotC(ir)
If CheckBox11.Checked = True Then
plotC2(ir)
End If
'-----重要---------------------------------
PictureBox1.Refresh() '毎回表示にRefresh必要
'-------------------------------------------
Next
moffX = 0
moffY = 0
'Debug.Print("plotEnd=" & CStr(sw.ElapsedMilliseconds))
'TextBox6.Text = "PlotEnd"
End If
End Sub
'hScroll4 set Line Bold
Private Sub Bold(Lwidth As Integer, rNum As Integer) '(startRowN As Integer, endRowN As Integer, speed As Single)
Kbold = Lwidth
delFlag = 0
plotC(rNum)
If CheckBox11.Checked = True Then
plotC2(rNum)
End If
'-----重要---------------------------------
PictureBox1.Refresh() '毎回表示にRefresh必要
'-------------------------------------------
'Next
moffX = 0
moffY = 0
'Debug.Print("plotEnd=" & CStr(sw.ElapsedMilliseconds))
'TextBox6.Text = "PlotEnd"
End Sub
Private Sub delBold(Lwidth As Integer, rNum As Integer) '(startRowN As Integer, endRowN As Integer, speed As Single)
Kbold = Lwidth
delFlag = 1
plotC(rNum)
If CheckBox11.Checked = True Then
plotC2(rNum)
End If
'-----重要---------------------------------
PictureBox1.Refresh() '毎回表示にRefresh必要
'-------------------------------------------
'Next
moffX = 0
moffY = 0
'Debug.Print("plotEnd=" & CStr(sw.ElapsedMilliseconds))
'TextBox6.Text = "PlotEnd"
End Sub
Private Sub dgv1_MouseDoubleClick(sender As Object, e As MouseEventArgs) Handles dgv1.MouseDoubleClick
Dim rIn As Integer = dgv1.CurrentCell.RowIndex
dgv1.Rows.Insert(rIn)
End Sub
Private Sub HScrollBar4_Click(sender As Object, e As EventArgs) Handles HScrollBar4.Click
Dim maxV, minV As Integer
minV = Val(TextBox4.Text)
maxV = Val(TextBox5.Text)
HScrollBar4.Maximum = maxV + 9
HScrollBar4.Minimum = minV
End Sub
'timer set
Private Sub Button13_Click(sender As Object, e As EventArgs) Handles Button13.Click
rN0 = Val(TextBox7.Text)
hour0 = hourN
min0 = minN
sec0 = secN
msec0 = msecN
Label30.Text = "TimerSet Zero at=No" + CStr(rN0) + ":" + CStr(hour0) + ":" + CStr(min0) + ":" + CStr(sec0) + "." + CStr(msec0)
End Sub
Private Sub HScrollBar4_MouseEnter(sender As Object, e As EventArgs) Handles HScrollBar4.MouseEnter
Hsc4 = 1
End Sub
Private Sub HScrollBar4_MouseLeave(sender As Object, e As EventArgs) Handles HScrollBar4.MouseLeave
Hsc4 = 0
End Sub
End Class
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment