Skip to content

Instantly share code, notes, and snippets.

@dj1711572002

dj1711572002/STA22_BitmapGraph_Cursor_rev030.vb Secret

Created February 12, 2022 11:04
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/3fd4a496dda9140cd027f68a687ba482 to your computer and use it in GitHub Desktop.
Save dj1711572002/3fd4a496dda9140cd027f68a687ba482 to your computer and use it in GitHub Desktop.
Download ZIP
VB.NET Ski Turn Analyzer Animation Graph Cursor Program
Raw
STA22_BitmapGraph_Cursor_rev030.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
Imports Shell32
Imports System.Drawing.Drawing2D
Imports System.Drawing.Imaging
'Imports EnvDTE
Imports Microsoft.VisualStudio.VCProjectEngine
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()
'=============dgv1=========================
Public copyCol()
Public copyRow()
'================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 ' = 1120 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
Public pxb2, pyb2, pxr2, pyr2 As Integer
Public pxb2_1, pyb2_1, pxr2_1, pyr2_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 autostep As Integer
Public autostart As Integer
Public autocount As Integer
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
'---SlideMovie　Graph Rotate Trim -----------------------------
Public bmap1 As Bitmap 'ソースデータ画像
Public bmap2 As Bitmap
Public maxX, minX, maxY, minY, rangeX, rangeY, aveX, aveY As Integer
Public maxX2, minX2, maxY2, minY2, rangeX2, rangeY2, aveX2, aveY2 As Integer
Public g1 As Graphics
Public g2 As Graphics
Public RX() As Integer 'ソースbitmapのpbx配列
Public RY() As Integer 'ソースbitmapのpby配列
Public LX() As Integer 'ソースbitmapのpbx2配列
Public LY() As Integer 'ソースbitmapのpby2配列
Public p As Pen
Public Fy() As Double 'Plotした点をX値でY値を導く Fy(x)
'=======================================================================================
'===============plotb GRAPHIC declarations====================================================
'=======================================================================================
Public slopeHeight() As Double
Dim grfBitmap As Bitmap
Dim cursorBitmap As Bitmap
'--------GetPos() Global para---------------------------
Public RNlon, RNlat, RNheight, RNrelN, RNrelE, RNrelD As Integer
Public LNlon, LNlat, LNheight, LNrelN, LNrelE, LNrelD As Integer
Public RNheadmot, LNheadmot, RNskihead, LNskihead As Double
Public slipAngleR As Double
Public slipAngleL As Double
Public thetaRb As Double 'plotbで始点と終点を水平に回転させる角度
Public Rflags, Rhacc, Rpdop As Integer
Public Lflags, Lhacc, Lpdop As Integer
Dim SkidRmax, SkidRmin, SkidRave As Double
Dim SkidLmax, SkidLmin, SkidLave As Double
'--plotb --プロット座標とデータの関係を持たせる配列60000確保
Public pbxrNR(100000), pbyrNR(100000), pbxrNL(100000), pbyrNL(100000) As Integer
Public lastpbxrNR As Integer
'---Plot para-------------------------------
Public Axb1_1, Ayb1_1, Axr1_1, Ayr1_1, Axb2_1, Ayb2_1, Axr2_1, Ayr2_1 As Integer
Private Sub CheckBox30_CheckedChanged(sender As Object, e As EventArgs) Handles CheckBox30.CheckedChanged
If CheckBox30.Checked = True Then
Panel2.Visible = True
Panel2.BringToFront()
Panel3.Visible = True
Panel3.BringToFront()
Else
Panel2.Visible = False
Panel3.Visible = False
End If
End Sub
Public Axb1_2, Ayb1_2, Axr1_2, Ayr1_2, Axb2_2, Ayb2_2, Axr2_2, Ayr2_2 As Integer
'PictureBox2 Visible スイッチ
Private Sub CheckBox31_CheckedChanged(sender As Object, e As EventArgs) Handles CheckBox31.CheckedChanged
If CheckBox2.Checked = True Then
PictureBox2.Visible = True
Else
PictureBox2.Visible = False
End If
End Sub
Private Sub dgv2_CellContentClick(sender As Object, e As DataGridViewCellEventArgs) Handles dgv2.CellContentClick
End Sub
Public Apx0, Apy0 As Integer
Public Apx0_1, Apy0_1 As Integer
Public Apx0_2, Apy0_2 As Integer
' Draw String関係------------------------------------
Public speedR, headR, skiR, slipR As Double
Public speedR_1, headR_1, skiR_1, slipR_1 As Double
Public speedRF, headRF, skiRF, slipRF As String
Public speedL, headL, skiL, slipL As Double
Public speedL_1, headL_1, skiL_1, slipL_1 As Double
Public speedLF, headLF, skiLF, slipLF As String
Public elevation, elevation_1, elevationS, elevationE, elevationR As Double
Public headR4, headR4_1, hedL4, headL4_1 As Double 'movingAverage HeadR headL
'Time Graph----------------------------------
Dim Gpx1, Gpx2, Gpx3, Gpx4, Gpx5 As Integer
Dim Gpy1, Gpy2, Gpy3, Gpy4, Gpy5 As Integer
Dim Gpy12, Gpy22, Gpy32, Gpy42, Gpy52 As Integer
Dim Gpx1_1, Gpx2_1, Gpx3_1, Gpx4_1, Gpx5_1 As Integer
Dim Gpy1_1, Gpy2_1, Gpy3_1, Gpy4_1, Gpy5_1 As Integer
Dim Gpy12_1, Gpy22_1, Gpy32_1, Gpy42_1, Gpy52_1 As Integer
Dim px1(), px2(), px3(), px4(), px5(), px6() As Integer
Dim py1(), py2(), py3(), py4(), py5(), py6() As Integer
'-------------------Pictures Parameter-----------------------------------------------------------
Public maxV, minV As Integer ' Hscrollbar4を自動移動
'画像ファイルを読み込む
Public period As Double ' MP4 Frameの周期
Public FileCount As Integer
Public folderName As String
Public MP4FileName As String()
Public fullFileName As String
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
Public rN_1 As Integer
'---TURN CUTTER ----------------------------
Public rN_turnNo() As Integer 'rNturnNo(rN-val(TextBox4.text))=turnNo
Public NutralR(10000) As Integer '1:Nutral 0=In turn
Public NutralL(10000) As Integer '1:Nutral 0=In turn
Public turnNoR(500) As Integer 'Nutralポイント番号とデータ行番号Nutral Point No in RowNumber
Public turnNoL(500) As Integer 'Nutral Point No in RowNumber
Public TurnNumR, TurnNumL As Integer 'Nutralポイント全数カウント値ターン番号は
Public Rpxb(), Rpyb(), Rpxr(), Rpyr() As Integer '右スキー正規座標配列
Public Lpxb(), Lpyb(), Lpxr(), Lpyr() As Integer '左スキー正規座標配列
Public RpybMax, RpyrMax As Integer '右スキーターン弧の最大高さ
Public LpybMax, LpyrMax As Integer '左スキーターン弧の最大高さ
Public currentX, currentY As Integer '現在のPictureBox　X座標値
'---DataGridiew array----------------------
Public Arrdgv() As DataGridView 'Arrdgv(0)=dgv1 Arrdgv(1)=dgv2
Public SlideVal_1, Slideplus, Slideminus As Integer '1回前のSlideVal
'******************* ターン構造体　turns********************************************************
Private Structure Turns
'Public rNturnNo() As Integer 'rNturnNo(rN)=turnNo
Public skiRL As String '左右スキーの指定(0)番に収納
Public turnNo As Integer 'ターン番号
Public direction As String 'ターン方向 R L
Public lastNo As Integer 'ターンの数(0)番に収納
Public startNo, endNo As Integer '開始データ行No
Public initX, initY, endX, endY As Integer '開始座標、終了座標　X:lon Y:lat
Public turnTime As Double 'ターン時間
Public turnTimesum As Double '累積ターン経過時間
'ターン弧
Public Radius As Double '簡易円近似半径
Public theta As Double 'fallLine 角度
Public minorDia, majorDia As Integer 'ターン半円の縦短径、横長径
Public Aspectratio As Double 'ターン弧のアスペクト比
Public fallen As Double 'fallLine長さ
Public fallensum As Double ' fallLineの累計
Public initHeight, endHeight As Double
Public fallHeight As Double 'fallLineの標高差
Public fallHeightsum As Double 'fallLine標高差の累計
Public Slopedeg As Double 'fallLineの斜度deg
Public Arclen As Double '円弧長
Public Arclensum As Double '円弧長の累計
'Speed
Public Speed() As Double 'Speed配列
Public inSpeed, outSpeed, aveSpeed, maxSpeed, minSpeed As Double 'ターン中の速度各種
'Heading Skidding
Public headMot() As Double 'headMot角配列
Public headSki() As Double 'ski角配列
Public Skid() As Double 'Skid角配列
Public maxHeadmot, minHeadmot, dHeadmot As Double 'headMot角各種
Public maxSkid, minSkid, aveSkid, dSkid As Double
'G Acceleration
Public Gacc() As Double '平均加速度
Public Gaccmax, Gaccmin, Gaccave As Double
'Slope　ターン開始点標高と終了点標高と傾斜角
Public startHeight As Double
Public lastHeight As Double
Public tSlope As Double
End Structure
'ターン構造体　パラメータ宣言
Private tR(200) As Turns '右スキーのターン構造体配列宣言２００個まで収納
Private tL(200) As Turns '左スキーのターン構造体配列宣言２００個まで収納
'dgv2 visible checkbox29
'Private Sub CheckBox29_CheckedChanged(sender As Object, e As EventArgs) Handles CheckBox29.CheckedChanged
'End Sub
Private Sub CheckBox29_MouseClick(sender As Object, e As MouseEventArgs) Handles CheckBox29.MouseClick
If dgv2.Visible = True Then
dgv2.Visible = False
Else
' dgv2.Visible = True
End If
End Sub
Private Sub headText()
dgv2.Columns(0).HeaderText = "turnNo"
dgv2.Columns(1).HeaderText = "skiRL"
dgv2.Columns(2).HeaderText = "direction"
dgv2.Columns(3).HeaderText = "turnR" + vbCrLf + " m"
dgv2.Columns(4).HeaderText = "aveSkid" + vbCrLf + " deg"
dgv2.Columns(5).HeaderText = "aveSpd" + vbCrLf + " km/h"
dgv2.Columns(6).HeaderText = "GaccMax" + vbCrLf + "m/sec2"
dgv2.Columns(7).HeaderText = "Slopdeg" + vbCrLf + " deg"
dgv2.Columns(8).HeaderText = "Aspctrto"
dgv2.Columns(9).HeaderText = "fallensum" + vbCrLf + " m"
dgv2.Columns(10).HeaderText = "Arclensum" + vbCrLf + " m"
dgv2.Columns(11).HeaderText = "fallDescent" + vbCrLf + " m"
dgv2.Columns(12).HeaderText = "turnTim" + vbCrLf + " sec"
dgv2.Columns(13).HeaderText = "turnTimsum" + vbCrLf + " sec"
End Sub
'***********************************************************************************************************************
'TURNMeasure Button
Private Sub Button19_Click(sender As Object, e As EventArgs) Handles Button19.Click
Dim i As Integer
'dgv2.Visible = True
dgv2.Rows.Clear()
CheckBox29.Checked = True 'dgv2 visible check
tR(0).skiRL = "R"
tL(0).skiRL = "L"
For i = 0 To tR(0).lastNo
turnCalc(i)
'Debug.Print("RSki[" + tR(i).direction + "turn]tR(" + CStr(i) + "):minorDia=," + CStr(tR(i).minorDia) + "cm,majorDia =," + CStr(tR(i).majorDia) + "cm, AspectRatio=," + tR(i).Aspectratio.ToString("0.00") + "fallen= " + CStr(tR(i).fallen) + "RowNo[" + CStr(tR(i).startNo) + "-" + CStr(tR(i).endNo) + "===============================")
' Debug.Print("LSKi[" + tR(i).direction + "turn]tR(" + CStr(i) + ")minorDia =," + CStr(tL(i).minorDia) + "cm,majorDia =," + CStr(tL(i).majorDia) + "cm, AspectRatio=," + tL(i).Aspectratio.ToString("0.00") + "fallen= " + CStr(tL(i).fallen) + "RowNo[" + CStr(tL(i).startNo) + "-" + CStr(tL(i).endNo) + "===============================" + vbCrLf)
Next i
End Sub
'====================================================================================================================
'TurnTable Making for plotB
Private Sub turntable()
Dim i As Integer
'dgv2.Visible = True
dgv2.Rows.Clear()
CheckBox29.Checked = True 'dgv2 visible check
tR(0).skiRL = "R"
tL(0).skiRL = "L"
For i = 0 To tR(0).lastNo
turnCalc(i)
'Debug.Print("RSki[" + tR(i).direction + "turn]tR(" + CStr(i) + "):minorDia=," + CStr(tR(i).minorDia) + "cm,majorDia =," + CStr(tR(i).majorDia) + "cm, AspectRatio=," + tR(i).Aspectratio.ToString("0.00") + "fallen= " + CStr(tR(i).fallen) + "RowNo[" + CStr(tR(i).startNo) + "-" + CStr(tR(i).endNo) + "===============================")
' Debug.Print("LSKi[" + tR(i).direction + "turn]tR(" + CStr(i) + ")minorDia =," + CStr(tL(i).minorDia) + "cm,majorDia =," + CStr(tL(i).majorDia) + "cm, AspectRatio=," + tL(i).Aspectratio.ToString("0.00") + "fallen= " + CStr(tL(i).fallen) + "RowNo[" + CStr(tL(i).startNo) + "-" + CStr(tL(i).endNo) + "===============================" + vbCrLf)
Next i
End Sub
'========================TURN Calculation============================================================================
Private Sub turnCalc(ByVal tN As Integer) 'ターン構造体型配列番号を引き渡して左右ターンをまとめて計算する
Nutral() 'Nutral点をカウントしておく
'***************************TURN パラメータリスト****************************************************
'==========================TURNの各パラメータ計算========
Dim it, iu As Integer
Dim RturnstartNo, RturnendNo As Integer
Dim LturnstartNo, LturnendNo As Integer
Dim initXR, initYR, endXR, endYR As Integer
Dim initXL, initYL, endXL, endYL As Integer
Dim initHiR, initHiL, endHiR, endHiL As Double
RpybMax = 0
RpyrMax = 0
LpybMax = 0
LpyrMax = 0
'ターン番号を回しながら左右同時ターンパラメータ計算して得る-----------------
'For it = 0 To tR(0).lastNo - 1 'TurnNumR - 2 'Nutral番号のitとit+1の間のターン番号がitとする:右ターン番号基準=
RturnstartNo = tR(tN).startNo 'turnNoR(it)
RturnendNo = tR(tN).endNo 'turnNoR(it + 1)
LturnstartNo = tL(tN).startNo 'turnNoR(it)
LturnendNo = tL(tN).endNo 'turnNoR(it + 1)
Dim tNumR As Integer = RturnendNo - RturnstartNo + 1 'Rターン内のデータ数
Dim tNumL As Integer = LturnendNo - LturnstartNo + 1 'Lターン内のデータ数
ReDim Rpxb(tNumR), Rpyb(tNumR), Rpxr(tNumR), Rpyr(tNumR) '座標配列再宣言
ReDim Lpxb(tNumL), Lpyb(tNumL), Lpxr(tNumL), Lpyr(tNumL) '座標配列再宣言
ReDim tR(tN).Speed(tNumR), tR(tN).headMot(tNumR), tR(tN).headSki(tNumR), tR(tN).Skid(tNumR)
ReDim tL(tN).Speed(tNumL), tL(tN).headMot(tNumL), tL(tN).headSki(tNumL), tL(tN).Skid(tNumL)
ReDim tR(tN).Gacc(tNumR), tL(tN).Gacc(tNumL) '加速度配列
'====================TURN 時間計算=============================
tR(tN).turnTime = (RturnendNo - RturnstartNo - 1) * 0.125
tL(tN).turnTime = (LturnendNo - LturnstartNo - 1) * 0.125
If tN > 0 Then
tR(tN).turnTimesum = tR(tN - 1).turnTimesum + tR(tN).turnTime
tL(tN).turnTimesum = tL(tN - 1).turnTimesum + tL(tN).turnTime
Else 'tN=0の時
tR(tN).turnTimesum = tR(tN).turnTime
tL(tN).turnTimesum = tL(tN).turnTime
End If
'----------フォールライン回転角度と距離-------------------------------------------------
'Debug.Print("turnCald 1stgetpos")
GetPos(RturnstartNo) 'RNlon,RNlat,RNheight,RNrelN,RNrelE,RNreLD
initXR = RNlon
initYR = RNlat
initHiR = RNheight / 10 'Height mm=> cm
initXL = LNlon
initYL = LNlat
initHiL = LNheight / 10 'Height mm=> cm
tR(tN).initX = initXR
tR(tN).initY = initYR
tR(tN).initHeight = initHiR
tL(tN).initX = initXL
tL(tN).initY = initYL
tL(tN).initHeight = initHiL
' Debug.Print("turnCald 2nd getpos ")
GetPos(RturnendNo)
endXR = RNlon
endYR = RNlat
endHiR = RNheight / 10 'Height mm=> cm
endXL = LNlon
endYL = LNlat
endHiL = LNheight / 10 'Height mm=> cm
tR(tN).endX = endXR
tR(tN).endY = endYR
tR(tN).endHeight = endHiR
tL(tN).endX = endXL
tL(tN).endY = endYL
tL(tN).endHeight = endHiL
'Debug.Print("RturnstartNo=," + CStr(RturnstartNo) + ",RturnendNo=," + CStr(RturnendNo) + ",initX=," + CStr(initX) + ",initY=," + CStr(initY) + ",endX=," + CStr(endX) + ",endY=," + CStr(endY))
Dim thetaR As Double = Math.Atan((endYR - initYR) / (endXR - initXR))
tR(tN).theta = thetaR
Dim SinthR As Double = Math.Sin(-thetaR)
Dim CosthR As Double = Math.Cos(-thetaR)
Dim fallR As Double = Math.Sqrt((endXR - initXR) ^ 2 + (endYR - initYR) ^ 2)
Dim fallL As Double = Math.Sqrt((endXL - initXL) ^ 2 + (endYL - initYL) ^ 2)
'================================================================================
'Dim minorDia, majorDia As Integer
Dim fallRX, fallLX As Double '回転正規化後のfallRの長さ検算
'横滑り角度Skidの最大最小
Dim SkidRsum As Double = 0
Dim SkidLsum As Double = 0
Dim ArcsumR As Double = 0
Dim ArcsumL As Double = 0
Dim speedsumR As Double = 0
Dim speedsumL As Double = 0
Dim GaccsumR As Double = 0
Dim GaccmaxR As Double = 0
Dim GaccminR As Double = 10000
Dim GaccsumL As Double = 0
Dim GaccmaxL As Double = 0
Dim GaccminL As Double = 10000
'大小比較初期値
tR(tN).maxSkid = 0
tR(tN).minSkid = 360
tL(tN).maxSkid = 0
tL(tN).minSkid = 360
'--------------------------------------------------------------------------------------------------------------------
' Debug.Print("======TurnNo it=" + CStr(it) + "thetaR=" + CStr(thetaR) + "fallR=" + CStr(fallR))
'正規化座標計算 iuがターン内のデータ番号スタートが0,エンドが tNR-1
'==========================================================================================================
'Rスキー計算===============================================================================================
'==========================================================================================================
For iu = 0 To tNumR - 1
' Debug.Print("turnCald 3rd getpos iu= " + CStr(iu))
GetPos(iu + RturnstartNo) 'dgv1からRTK座標,角度、速度読取り
'turnNOとrNの配列作成
'--Right Ski---------------
Rpxb(iu) = CInt((RNlon * CosthR - RNlat * SinthR)) ' theata だけ座標回転
Rpyb(iu) = CInt((RNlon * SinthR + RNlat * CosthR)) ' theata だけ座標回転
Rpxr(iu) = CInt(((RNlon + RNrelE) * CosthR - (RNlat + RNrelN) * SinthR)) ' theata だけ座標回転
Rpyr(iu) = CInt(((RNlon + RNrelE) * SinthR + (RNlat + RNrelN) * CosthR)) ' theata だけ座標回転
If iu > 0 Then
Dim rR As Double = Math.Sqrt((Rpxb(iu) - Rpxb(iu - 1)) ^ 2 + (Rpyb(iu) - Rpyb(iu - 1)) ^ 2)
ArcsumR = ArcsumR + rR
'Debug.Print("ArcR:rR=" + CStr(rR) + "ArcsumR=" + CStr(ArcsumR))
End If
'Right head角度 Speed 配列代入
tR(tN).headMot(iu) = RNheadmot
tR(tN).headSki(iu) = RNskihead
tR(tN).Speed(iu) = speedR
speedsumR = speedsumR + speedR
tR(tN).Skid(iu) = slipAngleR ' RNheadmot - (RNskihead) 'Math.Abs(RNheadmot - RNskihead)
SkidRsum = SkidRsum + tR(tN).Skid(iu)
If Math.Abs(tR(tN).maxSkid) <= Math.Abs(tR(tN).Skid(iu)) Then
tR(tN).maxSkid = Math.Abs(tR(tN).Skid(iu))
End If
If Math.Abs(tR(tN).minSkid) >= Math.Abs(tR(tN).Skid(iu)) Then
tR(tN).minSkid = Math.Abs(tR(tN).Skid(iu))
End If
'--Max check------------
If Math.Abs(Rpyb(iu) - Rpyb(0)) > RpybMax Then
RpybMax = Math.Abs(Rpyb(iu) - Rpyb(0))
End If
fallRX = Rpxb(iu) - Rpxb(0)
'-----------------------------Gacc計算--------------------------------------
If iu > 0 Then
Dim Alfa As Double = Math.Abs(tR(tN).headMot(iu) - tR(tN).headMot(iu - 1))
Dim Alfarad As Double = Alfa * Math.PI / 180
Dim cosAlfa As Double = Math.Cos(Alfarad)
Dim sinAlfa As Double = Math.Sin(Alfarad)
Dim V0 As Double = tR(tN).Speed(iu) * 0.277778 'kmh=>m/sec
Dim V1 As Double = tR(tN).Speed(iu - 1) * 0.277778 'kmh=>m/sec
Dim L As Double = V0 * sinAlfa
Dim m As Double = V1 - V0 * cosAlfa
Dim deltaV As Double = Math.Sqrt(L ^ 2 + m ^ 2)
Dim G01R As Double = deltaV / 0.125
tR(tN).Gacc(iu) = G01R
GaccsumR = GaccsumR + G01R
If G01R > GaccmaxR Then
GaccmaxR = G01R
End If
If G01R < GaccminR Then
GaccminR = G01R
End If
End If
Next iu
'====GaccR加速度代入==========================================
tR(tN).Gaccave = GaccsumR / (tNumR - 1)
tR(tN).Gaccmax = GaccmaxR
tR(tN).Gaccmin = GaccminR
'==============================================================================
'tR() 代入
'==============================================================================
'フォールライン距離fallen
tR(tN).fallen = fallR
'==============標高差:fallHeightと斜度計算:Slopedeg================================================
tR(tN).fallHeight = initHiR - endHiR
tR(tN).Slopedeg = Math.Atan((initHiR - endHiR) / fallR) * 180 / Math.PI
'=========ForLoopの結果===================================
tR(tN).aveSpeed = speedsumR / tNumR
tR(tN).Arclen = CInt(ArcsumR)
If tN > 0 Then
tR(tN).fallensum = tR(tN - 1).fallensum + tR(tN).fallen 'フォールラインの距離累計
tR(tN).Arclensum = tR(tN - 1).Arclensum + tR(tN).Arclen 'ターン弧の距離累計
tR(tN).fallHeightsum = tR(tN - 1).fallHeightsum + tR(tN).fallHeight '累積標高差
Else 'tN=0の時
tR(tN).Arclensum = tR(tN).fallen
tR(tN).Arclensum = tR(tN).Arclen
tR(tN).fallHeightsum = tR(tN).fallHeight
End If
tR(tN).aveSpeed = speedsumR / tNumR
tR(tN).aveSkid = SkidRsum / tNumR
tR(tN).inSpeed = tR(tN).Speed(0)
tR(tN).outSpeed = tR(tN).Speed(tNumR)
'右円弧寸法
tR(tN).fallen = fallRX
tR(tN).minorDia = RpybMax
tR(tN).majorDia = Rpxb(tNumR - 1) - Rpxb(0)
tR(tN).Aspectratio = tR(tN).minorDia / tR(tN).majorDia
tR(tN).Radius = (tR(tN).majorDia ^ 2 / 4 + tR(tN).minorDia ^ 2) / (2 * tR(tN).minorDia * 100) 'cm=>m
'===================================================================================================
'Lスキーの計算======================================================================================
'===================================================================================================
For iu = 0 To tNumL - 1
'Debug.Print("tuenCald 4th getpos iu= " + CStr(iu))
GetPos(iu + LturnstartNo) 'dgv1からRTK座標読取り
'--Left Ski---------------
Lpxb(iu) = CInt((LNlon * CosthR - LNlat * SinthR)) ' theata だけ座標回転
Lpyb(iu) = CInt((LNlon * SinthR + LNlat * CosthR)) ' theata だけ座標回転
Lpxr(iu) = CInt(((LNlon + LNrelE) * CosthR - (LNlat + LNrelN) * SinthR)) ' theata だけ座標回転
Lpyr(iu) = CInt(((LNlon + LNrelE) * SinthR + (LNlat + LNrelN) * CosthR)) ' theata だけ座標回転
If iu > 0 Then
ArcsumL = ArcsumL + Math.Sqrt((Lpxb(iu) - Lpxb(iu - 1)) ^ 2 + (Lpyb(iu) - Lpyb(iu - 1)) ^ 2)
End If
'Left head角度 Speed 配列代入
tL(tN).headMot(iu) = LNheadmot
tL(tN).headSki(iu) = LNskihead
tL(tN).Speed(iu) = speedL
speedsumL = speedsumL + speedL
tL(tN).Skid(iu) = slipAngleL 'LNheadmot - (LNskihead) 'Math.Abs(LNheadmot - LNskihead)
SkidLsum = SkidLsum + tL(tN).Skid(iu)
If Math.Abs(tL(tN).maxSkid) <= Math.Abs(tL(tN).Skid(iu)) Then
tL(tN).maxSkid = Math.Abs(tL(tN).Skid(iu))
End If
If Math.Abs(tL(tN).minSkid) >= Math.Abs(tL(tN).Skid(iu)) Then
tL(tN).minSkid = Math.Abs(tL(tN).Skid(iu))
End If
'--Max check------------
If Math.Abs(Lpyb(iu) - Lpyb(0)) > LpybMax Then
LpybMax = Math.Abs(Lpyb(iu) - Lpyb(0))
End If
fallLX = Lpxb(iu) - Lpxb(0)
'-----------------------------Gacc計算--------------------------------------
If iu > 0 Then
Dim Alfa As Double = Math.Abs(tL(tN).headMot(iu) - tL(tN).headMot(iu - 1))
Dim Alfarad As Double = Alfa * Math.PI / 180
Dim cosAlfa As Double = Math.Cos(Alfarad)
Dim sinAlfa As Double = Math.Sin(Alfarad)
Dim V0 As Double = tL(tN).Speed(iu) * 0.277778 'kmh=>m/sec
Dim V1 As Double = tL(tN).Speed(iu - 1) * 0.277778 'kmh=>m/sec
Dim L As Double = V0 * sinAlfa
Dim m As Double = V1 - V0 * cosAlfa
Dim deltaV As Double = Math.Sqrt(L ^ 2 + m ^ 2)
Dim G01L As Double = deltaV / 0.125
tL(tN).Gacc(iu) = G01L
GaccsumL = GaccsumL + G01L
If G01L > GaccmaxL Then
GaccmaxL = G01L
End If
If G01L < GaccminL Then
GaccminL = G01L
End If
' Debug.Print("L:tL(" + CStr(tN) + ").Gacc(" + CStr(iu) + ")=" + CStr(tL(tN).Gacc(iu)) + "GaccmaxL=" + CStr(GaccmaxL))
End If
Next iu
'====GaccR加速度代入==========================================
tL(tN).Gaccave = GaccsumL / (tNumL - 1)
tL(tN).Gaccmax = GaccmaxL
tL(tN).Gaccmin = GaccminL
'==============================================================================
'tL() 代入
'==============================================================================
'フォールライン距離fallen
tL(tN).fallen = fallL
'==============標高差:fallHeightと斜度計算:Slopedeg================================================
tL(tN).fallHeight = initHiL - endHiL
tL(tN).Slopedeg = Math.Atan((initHiL - endHiL) / fallL) * 180 / Math.PI
'=========ForLoopの結果===================================
tL(tN).aveSpeed = speedsumL / tNumL
tL(tN).Arclen = CInt(ArcsumL)
If tN > 0 Then
tL(tN).fallensum = tL(tN - 1).fallensum + tL(tN).fallen 'フォールラインの距離累計
tL(tN).Arclensum = tL(tN - 1).Arclensum + tL(tN).Arclen 'ターン弧の距離累計
tL(tN).fallHeightsum = tL(tN - 1).fallHeightsum + tL(tN).fallHeight '累積標高差
Else 'tN=0の時
tL(tN).Arclensum = tL(tN).fallen
tL(tN).Arclensum = tL(tN).Arclen
tL(tN).fallHeightsum = tL(tN).fallHeight
End If
tL(tN).aveSpeed = speedsumL / tNumL
tL(tN).Arclen = CInt(ArcsumL)
tL(tN).aveSkid = SkidLsum / tNumL
SkidLsum = 0
tL(tN).inSpeed = tL(tN).Speed(0)
tL(tN).outSpeed = tL(tN).Speed(tNumL)
'左円弧寸法
tL(tN).fallen = fallLX
tL(tN).minorDia = LpybMax
tL(tN).majorDia = Lpxb(tNumL - 1) - Lpxb(0)
tL(tN).Aspectratio = tL(tN).minorDia / tL(tN).majorDia
tL(tN).Radius = (tL(tN).majorDia ^ 2 / 4 + tL(tN).minorDia ^ 2) / (2 * tL(tN).minorDia * 100) 'cm=>m
'------------------------------------------------------------
' Debug.Print("TURN Calc: ,minorDia=," + CStr(minorDia) + "cm,majorDia =," + CStr(majorDia) + "cm, AspectRatio=," + (minorDia / majorDia).ToString("0.00") + "===============================")
'------------------------------dgv2へ書き込み------------------------
dgv2.ColumnCount = 100
headText()
If dgv2.Rows.Count = 0 Then
End If
dgv2.Rows.Add(tR(tN).turnNo, "Rski", tR(tN).direction, tR(tN).Radius.ToString("0.0"), tR(tN).aveSkid.ToString("0.0"), tR(tN).aveSpeed.ToString("0.0"), tR(tN).Gaccmax.ToString("0.00"), tR(tN).Slopedeg.ToString("0.0"), tR(tN).Aspectratio.ToString("0.00"), (tR(tN).fallensum / 100).ToString("0.0"), (tR(tN).Arclensum / 100).ToString("0.0"), (tR(tN).fallHeightsum / 100).ToString("0.0"), tR(tN).turnTime, tR(tN).turnTimesum)
dgv2.Rows.Add(tL(tN).turnNo, "Lski", tL(tN).direction, tL(tN).Radius.ToString("0.0"), tL(tN).aveSkid.ToString("0.0"), tL(tN).aveSpeed.ToString("0.0"), tL(tN).Gaccmax.ToString("0.00"), tL(tN).Slopedeg.ToString("0.0"), tL(tN).Aspectratio.ToString("0.00"), (tL(tN).fallensum / 100).ToString("0.0"), (tL(tN).Arclensum / 100).ToString("0.0"), (tL(tN).fallHeightsum / 100).ToString("0.0"), tL(tN).turnTime, tL(tN).turnTimesum)
dgv2.AutoSizeColumnsMode = DataGridViewAutoSizeColumnsMode.AllCells
dgv2.AutoSizeRowsMode = DataGridViewAutoSizeRowsMode.None
End Sub
'======================TURN CUTTER=================================================================================
'headMOTの極値をニュートラル（切り替え）ポイントとして抽出して、配列データとしてもって、ターングラフに重ねる
'へあｄMOTを5回MAして　微分してプラスマイナス変化点をポイントとする
Private Sub Button17_Click(sender As Object, e As EventArgs) Handles Button17.Click 'TURN CUTTER BUtton17
Nutral()
End Sub
'******************************ターンの切り替え点検出**************************************************************************************
'TRUNの切り替え点（NUTRAL　POINT）を検出　切り替え点データNO配列：NutralR,L(rN)=0(NO Nutral) or 1(Nutral) 　turnNoR,L(turnNo)=rN rNはデータ番号
' ターンの名称は、左手側に回ると左ターン:difheadR<0、右手側にまわると右ターン:difheadR>0
Private Sub Nutral()
Dim stNo As Integer = Int(TextBox4.Text)
Dim endNo As Integer = Int(TextBox5.Text)
Dim ic, i5 As Integer
Dim icR_1, icL_1 As Integer
Dim sum5R, sum5L As Double
Dim nuNR, nuNL As Integer
Dim numN As Integer = 0
Dim num As Integer = endNo - stNo
Dim MA5headR(endNo) As Double
Dim DifheadR(endNo) As Double
Dim MA5headL(endNo) As Double
Dim DifheadL(endNo) As Double
Dim turnCountR, turnCountL As Integer
Dim pared As Integer = 0
turnCountR = 0
turnCountL = 0
nuNR = 0
nuNL = 0
icR_1 = -8
icL_1 = -8
For ic = stNo To endNo - 5
numN += 1
sum5R = 0
sum5L = 0
For i5 = ic To 4 + ic
headR = (dgv1.Rows(i5).Cells(col_lon + 10).Value * 0.00001)
headL = (dgv1.Rows(i5).Cells(col2_lon + 10).Value * 0.00001)
sum5R = sum5R + headR
sum5L = sum5L + headL
Next i5
MA5headR(ic) = sum5R / 5
MA5headL(ic) = sum5L / 5
If ic > 0 Then
DifheadR(ic) = MA5headR(ic) - MA5headR(ic - 1)
DifheadL(ic) = MA5headL(ic) - MA5headL(ic - 1)
If DifheadR(ic) * DifheadR(ic - 1) < 0 And ic - icR_1 > 7 Then '前回から8個以上離れて正負逆転した場合NutralPointと判断
icR_1 = ic
If DifheadR(ic) < 0 Then
NutralR(ic) = -1 '左ターン
tR(turnCountR).direction = "Rturn"
Else
NutralR(ic) = 1 '右ターン
tR(turnCountR).direction = "Lturn"
End If
CheckBox12.Checked = True
turnNoR(nuNR) = ic 'ニュートラルポイントでの行番号記録
'*****ターン構造体記録****************************
'nuNR=1でtr.turnNo=0,nuNR=2でtr.turnNo=1
If nuNR > 0 Then
tR(turnCountR).turnNo = turnCountR '構造体へターン番号記録
tR(turnCountR).startNo = turnNoR(nuNR - 1) '構造体へスタート行番号記録
tR(turnCountR).endNo = turnNoR(nuNR) '構造体へスタート行番号記録
RichTextBox2.AppendText("tR(" + CStr(turnCountR) + ") = " + CStr(turnCountR) + ":tr.startNo=" + CStr(tR(turnCountR).startNo) + ",tr.endNo=" + CStr(tR(turnCountR).endNo) + vbCrLf)
turnCountR += 1
End If
'*************************************************
RichTextBox2.AppendText("NutralheadR(" + CStr(ic) + ") = " + CStr(1) + "TurnNoR(" + CStr(nuNR) + ")=" + CStr(ic) + "DifheadR(ic)=" + CStr(DifheadR(ic)) + vbCrLf)
nuNR += 1
Else
NutralR(ic) = turnCountR + 2 ' ターンNOを2個多く記憶
End If
If DifheadL(ic) * DifheadL(ic - 1) < 0 And ic - icL_1 > 7 Then '前回から8個以上離れて正負逆転した場合NutralPointと判断
icL_1 = ic
If DifheadL(ic) < 0 Then
NutralL(ic) = -1
tL(turnCountL).direction = "Rturn"
Else
NutralL(ic) = 1
tL(turnCountL).direction = "Lturn"
End If
CheckBox12.Checked = True
turnNoL(nuNL) = ic
'*****ターン構造体記録****************************
'nuNR=1でtr.turnNo=0,nuNR=2でtr.turnNo=1
If nuNL > 0 Then
tL(turnCountL).turnNo = turnCountL '構造体へターン番号記録
tL(turnCountL).startNo = turnNoL(nuNL - 1) '構造体へスタート行番号記録
tL(turnCountL).endNo = turnNoL(nuNL) '構造体へスタート行番号記録
RichTextBox2.AppendText("tL(" + CStr(turnCountL) + ") = " + CStr(turnCountL) + ":tL.startNo=" + CStr(tL(turnCountL).startNo) + ",tL.endNo=" + CStr(tL(turnCountL).endNo) + vbCrLf)
turnCountL += 1
End If
'*************************************************
RichTextBox2.AppendText("NutralheadL(" + CStr(ic) + ")=" + CStr(1) + "TurnNoL(" + CStr(nuNL) + ")=" + CStr(ic) + "DifheadL(ic)=" + CStr(DifheadL(ic)) + vbCrLf)
nuNL += 1
Else
NutralL(ic) = turnCountL + 2 ' ターンNOを2個多く記憶
End If
TurnNumR = nuNR
tR(0).lastNo = turnCountR - 1 'ターン最後番号をtR(0).lastNoに収納
TurnNumL = nuNL
tL(0).lastNo = turnCountL - 1 'ターン最後番号をtL(0).lastNoに収納
End If
'Debug.Print("NutralR(" + CStr(ic) + ")=" + CStr(NutralR(ic)))
'Debug.Print("NutralL(" + CStr(ic) + ")=" + CStr(NutralL(ic)))
Next ic
End Sub
'------------------------------------------------------------------------------------------------
'MP4ファイル時間取得　MP4は、コマ収納フォルダーに1個だけおいておくこと
Public Function getMP4time() As String 'msec で返す
Dim sTime As String = ""　'動画ファイルの時間
'Dim Dir As String = folderName
'Dim FileName As String = "Beginners-Alpen_VID_20210301_125623_00_016.mp4"
'ShellClassクラスのインスタンス生成
Dim sh As New Shell
'FolderItemインターフェイス
Dim fItem As FolderItem = Nothing
'Dim fInfo As FileInfo = New FileInfo(Dir & "\" & FileName)
Dim fInfo As FileInfo = New FileInfo(fullFileName)
'Folderインターフェイス
Dim f As Folder = sh.NameSpace(fInfo.DirectoryName)
fItem = f.ParseName(fInfo.Name)
'OS判定して、XP以前とインデックス区別
'(XPはMajor5 Minor:1、７はMajor:6 Minor:1、８はMajor:6 Minor:2)
Dim index As Integer = 0
Dim os As System.OperatingSystem = System.Environment.OSVersion
If os.Version.Major < 6 Then
index = 21
Else
index = 27
End If
sTime = f.GetDetailsOf(fItem, index) ' 長さが格納されたインデックス
Return sTime
End Function
'Asynchronized OK----------------------------------------------------------------------------------------
Private Sub CheckBox16_CheckedChanged(sender As Object, e As EventArgs) Handles CheckBox16.CheckedChanged
If CheckBox16.Checked = True Then
koma0 = picN
Label8.Text = "SynchroFixed[picN=" + CStr(picN) + "DataNo=" + TextBox7.Text + "]"
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 fstr As String = folderName + TextBox18.Text
Dim fnstr As String
fnstr = (n).ToString("D4") + ".jpg"
'fstr = fstr + fnstr
fstr = folderName + TextBox18.Text + 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)
If picN < FileCount - 2 Then
koma(picN)
End If
End If
End Sub
'===============================PictureBox2 にc:\SkiPic\フォルダ内フレームを表示===============================================
Private Sub Button14_Click(sender As Object, e As EventArgs) Handles Button14.Click
'----------Folder 指定-----------------------------------
'FolderBrowserDialogクラスのインスタンスを作成
Dim fbd As New FolderBrowserDialog
'上部に表示する説明テキストを指定する
fbd.Description = "フォルダを指定してください。"
'ルートフォルダを指定する
'デフォルトでDesktop
fbd.RootFolder = Environment.SpecialFolder.Desktop
'最初に選択するフォルダを指定する
'RootFolder以下にあるフォルダである必要がある
fbd.SelectedPath = "C:\SkiPic"
'ユーザーが新しいフォルダを作成できるようにする
'デフォルトでTrue
fbd.ShowNewFolderButton = True
'ダイアログを表示する
If fbd.ShowDialog(Me) = DialogResult.OK Then
'選択されたフォルダを表示する
Console.WriteLine(fbd.SelectedPath)
folderName = fbd.SelectedPath
End If
'Folder内のファイル数カウント
FileCount = Directory.GetFiles(folderName).Length
Label5.Text = "FileCount=" + CStr(FileCount)
'TrackBar Max値設定
TrackBar1.Maximum = FileCount - 1
'MP4フルファイル名取得
Dim files As IEnumerable(Of String) = System.IO.Directory.EnumerateFiles(folderName, "*.mp4", System.IO.SearchOption.AllDirectories)
fullFileName = files(0) '１個しか置いてないから(0)
'MP4時間取得
Dim MP4ts As String = getMP4time()
Label6.Text = "Time=" + MP4ts
'時間をmsecに換算してファイル周期を計算
Dim timeArry As String() = MP4ts.Split(":")
Dim timemsec As Integer = CInt(timeArry(0)) * 3600000 + CInt(timeArry(1)) * 60000 + CInt(timeArry(2)) * 1000
period = timemsec / (FileCount - 1)
Label7.Text = "Period=" + Format(period, "##.###") + "msec"
'--------------------------------------
PictureBox2.Visible = True
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_" '
Dim fstr As String = folderName + TextBox18.Text '"\Produce_"
Dim fnstr As String
fnstr = (picN).ToString("D4") + ".jpg"
fnstr = fstr + fnstr
Label31.Text = fstr
images(i) = Image.FromFile(fnstr)
'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
'Debug.print("======================USB Processing Part===============================")
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 = 60
'----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ヘッダー
'For i = 0 To 32
' dgv1.Columns(i + 1).HeaderText = headPVTArry(i)
'Next
'1:iTow-------------------------------
dgv1.Columns(1).HeaderText = "iTow"
Dim iTow As Integer = parPVT(1)
dgv1.Columns(1).Width = 60
'2:Year---------------------------
dgv1.Columns(2).HeaderText = "Year"
Dim Year As Integer = parPVT(2)
'3:month---------------------------
dgv1.Columns(3).HeaderText = "month"
Dim month As Integer = parPVT(3)
'4:day---------------------------
dgv1.Columns(4).HeaderText = "day"
Dim day As Integer = parPVT(4)
'5:hour---------------------------
dgv1.Columns(5).HeaderText = "hour"
Dim hour As Integer = parPVT(5)
'6:min---------------------------
dgv1.Columns(6).HeaderText = "min"
Dim min As Integer = parPVT(6)
'7:sec---------------------------
dgv1.Columns(7).HeaderText = "sec"
Dim sec As Integer = parPVT(7)
'8:valid---------------------------
dgv1.Columns(8).HeaderText = "valid"
Dim valid As Integer = parPVT(8)
'9:tAcc---------------------------
dgv1.Columns(9).HeaderText = "tAcc"
Dim tAcc As Integer = parPVT(9)
'10:nano---------------------------
dgv1.Columns(10).HeaderText = "nano"
Dim nano As Integer = parPVT(10)
'11:fixType-------------------------------
dgv1.Columns(11).HeaderText = "fixType"
Dim fixType As Integer = parPVT(11)
'12:flags-------------------------------
dgv1.Columns(12).HeaderText = "flags"
Dim flags As Integer = parPVT(12)
'13:flags2-------------------------------
dgv1.Columns(13).HeaderText = "flags2"
Dim flags2 As Integer = parPVT(13)
'14:numSV---------------------------------
dgv1.Columns(14).HeaderText = "numSV"
Dim numSV As Integer = parPVT(14)
'15:lon-----------------------------------
dgv1.Columns(15).HeaderText = "lon"
Dim lon As Integer = parPVT(15)
'16:lat-----------------------------------
dgv1.Columns(16).HeaderText = "lat"
Dim lat As Integer = parPVT(16)
'17:height-----------------------------------
dgv1.Columns(17).HeaderText = "height"
Dim height As Integer = parPVT(17)
'18:hMSL-----------------------------------
dgv1.Columns(18).HeaderText = "hMSL"
Dim hMSL As Integer = parPVT(18)
'19:hAcc-----------------------------------
dgv1.Columns(19).HeaderText = "hAcc"
Dim hAcc As Integer = parPVT(19)
'20:vAcc---------------------------------
dgv1.Columns(20).HeaderText = "vAcc"
Dim vAcc As Integer = parPVT(20)
'21:velN---------------------------------
dgv1.Columns(21).HeaderText = "velN"
Dim velN As Integer = parPVT(21)
'22:velE---------------------------------
dgv1.Columns(22).HeaderText = "velE"
Dim velE As Integer = parPVT(22)
'23:velD------------------------------------
dgv1.Columns(23).HeaderText = "velD"
Dim velD As Integer = parPVT(23)
'24:gSpeed------------------------------------
dgv1.Columns(24).HeaderText = "gSpeed"
Dim gSpeed As Integer = parPVT(24)
'25:headMot------------------------------------
dgv1.Columns(25).HeaderText = "headMot"
Dim headMot As Integer = parPVT(25)
'26:sAcc------------------------------------
dgv1.Columns(26).HeaderText = "sAcc"
Dim sAcc As Integer = parPVT(26)
'27:headAcc------------------------------------
dgv1.Columns(27).HeaderText = "headAcc"
Dim headAcc As Integer = parPVT(27)
'28:pDDOP------------------------------------
dgv1.Columns(28).HeaderText = "pDOP"
Dim pDOP As Integer = parPVT(28)
'29:flags3------------------------------------
dgv1.Columns(29).HeaderText = "flags3"
Dim flags3 As Integer = parPVT(29)
'30:reserved1------------------------------------
dgv1.Columns(30).HeaderText = "reserved1"
Dim reserved1 As Integer = parPVT(30)
'31:headVeh------------------------------------
dgv1.Columns(31).HeaderText = "headVeh"
Dim headVeh As Integer = parPVT(31)
'32:magDec------------------------------------
dgv1.Columns(32).HeaderText = "magDec"
Dim magDec As Integer = parPVT(32)
'33:magAcc------------------------------------
dgv1.Columns(33).HeaderText = "magAcc"
Dim magAcc As Integer = parPVT(33)
'--RELPOSNED ヘッダー
'1:iTow
dgv1.Columns(34).HeaderText = "RELP_iTow"
Dim RELP_iTOW As Integer = parRELP(1)
dgv1.Columns(35).HeaderText = "relPosN"
Dim relPosN As Single = parRELP(2) + parRELP(7) * 0.1
dgv1.Columns(36).HeaderText = "relPosE"
Dim relPosE As Single = parRELP(3) + parRELP(8) * 0.1
dgv1.Columns(37).HeaderText = "relPosD"
Dim relPosD As Single = parRELP(4) + parRELP(9) * 0.1
dgv1.Columns(38).HeaderText = "relPosLength"
Dim relPosLength As Single = parRELP(5) + parRELP(10) * 0.1
dgv1.Columns(39).HeaderText = "relPosHeading"
Dim relPosHeading As Single = parRELP(6) * 0.00001
dgv1.Columns(40).HeaderText = "reserved2"
Dim reserved2 As Single = parRELP(7) '* 0.00001
dgv1.Columns(41).HeaderText = "relPosHPN"
Dim relPosHPN As Single = parRELP(8) '* 0.00001
dgv1.Columns(42).HeaderText = "relPosHPE"
Dim relPosHPE As Single = parRELP(9) '* 0.00001
dgv1.Columns(43).HeaderText = "relPosHPD"
Dim relPosHPD As Single = parRELP(10) '* 0.00001
dgv1.Columns(44).HeaderText = "relPosHPLength"
Dim relPosHPLength As Single = parRELP(11) '* 0.00001
dgv1.Columns(45).HeaderText = "accN"
Dim accN As Single = parRELP(12) * 0.01
dgv1.Columns(46).HeaderText = "accE"
Dim accE As Single = parRELP(13) * 0.01
dgv1.Columns(47).HeaderText = "accD"
Dim accD As Single = parRELP(14) * 0.01
dgv1.Columns(48).HeaderText = "accLength"
Dim accLength As Single = parRELP(15) * 0.01
dgv1.Columns(49).HeaderText = "accHeading"
Dim accHeading As Single = parRELP(16) * 0.00001
'Debug.print("parRELP(16)=" + CStr(parRELP(16)) + "accHeading=", CStr(accHeading))
dgv1.Columns(50).HeaderText = "reserved3"
Dim reserved3 As Single = parRELP(17)
'Debug.print("parRELP(17)=" + CStr(parRELP(17)) + "reserved3=", CStr(reserved3))
dgv1.Columns(51).HeaderText = "flags"
Dim rflags As Single = parRELP(18)
'Debug.print("parRELP(18)=" + CStr(parRELP(18)) + "flags=", CStr(flags))
'===================行追加と一括書き込み===============================
'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, 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,
RELP_iTOW, relPosN, relPosE, relPosD, relPosLength, relPosHeading, reserved2, relPosHPN, relPosHPE, relPosHPD, relPosHPLength,
accN, accE, accD, accLength, accHeading, reserved3, rflags)
'------------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
'Debug.print("Error" + ReceivedData)
ReceivedData = ex.Message '例外処理を行います
End Try
'Invokeメソッドにより実行されるメソッドへのデリゲートの宣言を行い、受信データを表示します
Dim adre As New DataDelegate(AddressOf PrintData)
Me.Invoke(adre, ReceivedData)
'Invoke(adre, ReceivedData)
End If
End Sub
Private Sub Rinsert()
'Debug.print("Rinsert")
dgv1.Rows.Insert(dgv1.CurrentCell.RowIndex)
For i = 0 To dgv1.Rows.Count - 1
dgv1.Rows(i).HeaderCell.Value = i.ToString()
Next i
End Sub
Private Sub Rdelete()
'Dim SelCellRange As Integer = dgv1.Rows.GetRowCount(DataGridViewElementStates.Selected)
''Debug.print("Rdelete start=" + CStr(dgv1.CurrentCell.RowIndex) + "range=" + CStr(SelCellRange))
Dim r As DataGridViewRow
For Each r In dgv1.SelectedRows
If Not r.IsNewRow Then
dgv1.Rows.Remove(r)
End If
Next r
'dgv1.Rows.RemoveAt(dgv1.CurrentCell.RowIndex)
For i = 0 To dgv1.Rows.Count - 1
dgv1.Rows(i).HeaderCell.Value = i.ToString()
Next i
End Sub
Private Sub Rcopy()
'Debug.print("Rcopy")
Dim cX As Integer = dgv1.CurrentCell.ColumnIndex
Dim cY As Integer = dgv1.RowCount
Dim rX As Integer = dgv1.ColumnCount
Dim rY As Integer = dgv1.CurrentCell.RowIndex
ReDim copyCol(cY)
ReDim copyRow(rX)
For i = 0 To rX - 1
copyRow(i) = CStr(dgv1.Rows(rY).Cells(i).Value)
Next i
For i = 0 To dgv1.Rows.Count - 1
dgv1.Rows(i).HeaderCell.Value = i.ToString()
Next i
End Sub
Private Sub Rpaste()
'Debug.print("Rpaste")
'-------------列ペースト-----------------------------
'If RadioButton1.Checked = True Then
Dim cX As Integer = dgv1.CurrentCell.ColumnIndex
Dim cY As Integer = dgv1.RowCount
Dim rX As Integer = dgv1.ColumnCount
Dim rY As Integer = dgv1.CurrentCell.RowIndex
For i = 0 To rX - 1
dgv1.Rows(rY).Cells(i).Value = copyRow(i)
Next i
For i = 0 To dgv1.Rows.Count - 1
dgv1.Rows(i).HeaderCell.Value = i.ToString()
Next i
End Sub
'Private Sub headName()
'End Sub
'**************************************************************************************************
Private Sub Form1_Activated(sender As Object, e As EventArgs) Handles Me.Activated
'合計物理メモリ
Console.WriteLine("合計物理メモリ:{0}バイト", My.Computer.Info.TotalPhysicalMemory)
'利用可能な物理メモリ
Console.WriteLine("利用可能物理メモリ:{0}バイト", My.Computer.Info.AvailablePhysicalMemory)
'合計仮想メモリ
Console.WriteLine("合計仮想メモリ:{0}バイト", My.Computer.Info.TotalVirtualMemory)
'利用可能な仮想メモリ
Console.WriteLine("利用可能仮想メモリ:{0}バイト", My.Computer.Info.AvailableVirtualMemory)
'----------DGV Array set--------------------
Arrdgv = {Me.dgv1, Me.dgv2} 'Arrdgv(0)=dgv1,Arrdgv(1)=dgv2
'----------DGV contetmenustrip cMenu1:Row Editing add--------------------
cMenu1 = New ContextMenuStrip()
cMenu1.Items.Add("Insert", Nothing, New System.EventHandler(AddressOf Rinsert))
cMenu1.Items.Add("Delete", Nothing, New System.EventHandler(AddressOf Rdelete))
cMenu1.Items.Add("Copy", Nothing, New System.EventHandler(AddressOf Rcopy))
cMenu1.Items.Add("Paste", Nothing, New System.EventHandler(AddressOf Rpaste))
''+++++Header Name List ++++++++++++++++++++
'cMenu1.Items.Add("turnNO", Nothing, New System.EventHandler(AddressOf headName))
'cMenu1.Items.Add("skiRL", Nothing, New System.EventHandler(AddressOf headName))
'cMenu1.Items.Add("aveSkid", Nothing, New System.EventHandler(AddressOf headName))
'cMenu1.Items.Add("aveSpeed", Nothing, New System.EventHandler(AddressOf headName))
'cMenu1.Items.Add("Aspectratio", Nothing, New System.EventHandler(AddressOf headName))
'cMenu1.Items.Add("falldeg", Nothing, New System.EventHandler(AddressOf headName))
'cMenu1.Items.Add("fallen", Nothing, New System.EventHandler(AddressOf headName))
'cMenu1.Items.Add("Arclen", Nothing, New System.EventHandler(AddressOf headName))
'cMenu1.Items.Add("turnNO", Nothing, New System.EventHandler(AddressOf headName))
'cMenu1.Items.Add("turnNO", Nothing, New System.EventHandler(AddressOf headName))
'cMenu1.Items.Add("turnNO", Nothing, New System.EventHandler(AddressOf headName))
'cMenu1.Items.Add("turnNO", Nothing, New System.EventHandler(AddressOf headName))
'cMenu1.Items.Add("turnNO", Nothing, New System.EventHandler(AddressOf headName))
'cMenu1.Items.Add("turnNO", Nothing, New System.EventHandler(AddressOf headName))
'cMenu1.Items.Add("turnNO", Nothing, New System.EventHandler(AddressOf headName))
'============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 = "STA22_BitmapGraph_Cursor_rev030"
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(80)
'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,reserved2,relPosHPN,relPosHPE,relPosHPD,relPosHPLength,accN,accE,accD,accLength,accHeading,reserved3,flags"
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,17,18,19
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:reserved 28-31
parRELP(7) = relpI4(NVC, 28 + off)
'Debug.print("parRELP(7)=" & CStr(parRELP(7)))
'---------8:relPosHPN 32
parRELP(8) = CInt(bRELP(32 + off))
'Debug.print("parRELP(8)=" & CStr(parRELP(8)))
'---------9:relPosHPE 33
parRELP(9) = CInt(bPVT(33 + off))
'Debug.print("parRELP(9)=" & CStr(parRELP(9)))
'---------10:relPosHPD 34
parPVT(10) = CInt(bPVT(34 + off))
'Debug.print("parRELP(10)=" & CStr(parRELP(10)))
'--------11:relPosHPLength 35
parRELP(11) = CInt(bPVT(35 + off))
'Debug.print("parRELP(11)=" & CStr(parRELP(11)))
'--------12:accN 36-39
parRELP(12) = relpI4(NVC, 36 + off)
'Debug.print("parRELP(12)=" & CStr(parRELP(12)))
'--------13:accE 40-43
parRELP(13) = relpI4(NVC, 40 + off)
'Debug.print("parRELP(12)=" & CStr(parRELP(13)))
'--------14:accD 44-47
parRELP(14) = relpI4(NVC, 44 + off)
'Debug.print("parRELP(14)=" & CStr(parRELP(14)))
'--------15:accLength 48-51
parRELP(15) = relpI4(NVC, 48 + off)
'Debug.print("parRELP(15)=" & CStr(parRELP(15)))
'--------16:accHeading 52-55
parRELP(16) = relpI4(NVC, 52 + off)
'Debug.print("parRELP(16)=" & CStr(parRELP(16)))
'--------17:reserved3 56-59
parRELP(17) = relpI4(NVC, 56 + off)
'Debug.print("parRELP(17)=" & CStr(parRELP(17)))
'--------18:flags 60-63
parRELP(18) = relpI4(NVC, 60 + off)
'Debug.print("parRELP(18)=" & CStr(parRELP(18)))
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 + bPVT(sN + 1) * 256
Return i2
End Function
'------------------RELPOSNED --------------------------------------------------
Private Function relpI4(ByVal dnum As Integer, ByVal sN As Integer) As Integer
Dim i4 As Integer
'Debug.print("In_relpI4:bTELP()=" & CStr(sN) & "::" & CStr(bRELP(sN)) & "," & CStr(bRELP(sN + 1)) & "," & CStr(bRELP(sN + 2)) & "," & CStr(bRELP(sN + 3)))
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ファイルをUBXDEC変換：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 = 60
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ヘッダー
For i = 0 To 32
dgv1.Columns(i + 1).HeaderText = headPVTArry(i)
Next
'--------------旧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
dgv1.RowHeadersWidth = 60
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
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 - 15
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 イベント: CellMouseClick
' Private Sub dgv1_CellMouseClick(sender As Object, e As DataGridViewCellMouseEventArgs) _
'Handles dgv1.CellMouseClick
' If (e.Button = MouseButtons.Right) Then
' If (e.ColumnIndex >= 0 And e.RowIndex >= 0) Then
' dgv1.SelectedRow = e.RowIndex
' dgv1.DataGridView1.ClearSelection()
' dgv1.DataGridView1(e.ColumnIndex, e.RowIndex).Selected = True
' ' --- コンテキストメニューを表示
' dgv1.ContextMenuStrip1.Show(System.Windows.Forms.Cursor.Position)
' End If
' End If
' End Sub
'【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
'--------Auto step-------------
If CheckBox20.Checked = True Then
ClearImage()
autocount += 1
autostart = Int(TextBox8.Text)
autostep = Int(TextBox9.Text)
If autocount = 1 Then
TextBox4.Text = autostart
TextBox5.Text = autostart + autostep
Else
If CheckBox21.Checked = True Then
TextBox5.Text = TextBox4.Text
TextBox4.Text = Int(TextBox4.Text) - autostep ' StopNo to startNo
Else
TextBox4.Text = TextBox5.Text ' StopNo to startNo
TextBox5.Text = Int(TextBox4.Text) + autostep
End If
End If
centering()
End If
rePlay()
pcount = 0
Dim prange As String = TextBox4.Text & "," & TextBox5.Text
ComboBox4.Items.Add(prange)
End Sub
'-----Auto Back Button ------------------------------------------------------------
'Private Sub Button17_Click(sender As Object, e As EventArgs) Handles Button17.Click
' If CheckBox20.Checked = True Then
' autocount += 1
' autostart = Int(TextBox8.Text)
' autostep = Int(TextBox9.Text)
' If autocount = 1 Then
' TextBox4.Text = autostart
' TextBox5.Text = autostart + autostep
' Else
' TextBox4.Text = Int(TextBox4.Text) - autostep ' StopNo to startNo
' TextBox5.Text = Int(TextBox4.Text)
' End If
' centering()
' ClearImage()
' End If
'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
'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"
TextBox7.Text = TextBox4.Text '================= 20210610 change===================
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計算
If CheckBox22.Checked = False Then ' CheckBox22 checked rscale Fixed mode
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
End If
Label12.Text = CStr(rScale)
'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
Private Sub colNo()
' 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
' End If
CheckBox24.Checked = True
End Sub
'GraphPlotチェックボックスを変化させたときの処理-------------------------------------------------------
Private Sub CheckBox2_CheckedChanged(sender As Object, e As EventArgs) Handles CheckBox2.CheckedChanged
colNo()
PictureBox1.Visible = True
centering()
plotC(plotrowN)
'If CheckBox2.Checked = False Then
' PictureBox1.Visible = False
'End If
End Sub
Private Sub Button18_Click(sender As Object, e As EventArgs) Handles Button18.Click
PictureBox1.Visible = True
'If PictureBox1.Image Is Nothing Then '初回だけＢＩＴＭＡＰを定義する
'Dim bmp1X As Integer = CInt(rangeX * rScale) '20000
'Dim bmp1Y As Integer = CInt(rangeY * rScale) '10000
'bmap1 = New Bitmap(bmp1X, bmp1Y) ', PixelFormat.Format8bppIndexed)
'End If
plotB()
End Sub
'****************************GetPos(rN)**********************************************************
Private Sub GetPos(ByVal rN As Integer)
If CheckBox24.Checked = True Then 'Header Col items detected ---------------------
'---------------------Data form Dgv1------------------------------------------------------------
'righrt data reading
RNlon = dgv1.Rows(rN).Cells(col_lon).Value Mod 1000000 'cm
RNlat = (dgv1.Rows(rN).Cells(col_lati).Value) Mod 1000000 'cm
RNheight = (dgv1.Rows(rN).Cells(col_height).Value) 'mm
RNrelN = (dgv1.Rows(rN).Cells(col_N).Value) * RBset 'cm
RNrelE = (dgv1.Rows(rN).Cells(col_E).Value) * RBset 'cm
RNrelD = (dgv1.Rows(rN).Cells(col_D).Value) 'cm
'right head mot
RNheadmot = (dgv1.Rows(rN).Cells(col_lon + 10).Value * 0.00001) 'deg
RNskihead = (dgv1.Rows(rN).Cells(col_lon + 24).Value * 0.00001) - 180 'deg Bse -Rover逆補正
'right speed
speedR = (dgv1.Rows(rN).Cells(col_lon + 9).Value * 0.0036) 'kmh
slipAngleR = RNheadmot - RNskihead ' slipAngleR deg プロット　0-45deg-------------------------------
'---------------------------------------------------------------------
'Debug.Print("GETPOS:rN=" + CStr(rN) + "RNheadMot=" + CStr(RNheadmot) + "RNskihead=" + CStr(RNskihead) + "AlipAngleR=" + CStr(slipAngleR))
'----flags,hAcc pDOP
Rflags = (dgv1.Rows(rN).Cells(col_lon - 3).Value) * RBset 'cm
Rhacc = (dgv1.Rows(rN).Cells(col_lon + 4).Value) * RBset 'cm
Rpdop = (dgv1.Rows(rN).Cells(col_lon + 13).Value) * RBset 'cm
If Rpdop > 10 Then
Dim str As String = Convert.ToString(Rpdop, 16)
Dim str0 As String = Strings.Left(str, 2)
Dim str1 As String = Strings.Right(str, 2)
str = str1 + str0
Rpdop = Convert.ToInt32(str, 16)
End If
'left data reading
LNlon = (dgv1.Rows(rN).Cells(col2_lon).Value) Mod 1000000
LNlat = (dgv1.Rows(rN).Cells(col2_lati).Value) Mod 1000000
LNheight = (dgv1.Rows(rN).Cells(col2_height).Value)
LNrelN = (dgv1.Rows(rN).Cells(col2_N).Value) * RBset
LNrelE = (dgv1.Rows(rN).Cells(col2_E).Value) * RBset
LNrelD = (dgv1.Rows(rN).Cells(col2_D).Value)
'Left head mot
LNheadmot = (dgv1.Rows(rN).Cells(col2_lon + 10).Value * 0.00001)
LNskihead = (dgv1.Rows(rN).Cells(col2_lon + 24).Value * 0.00001) - 180 'deg Bse -Rover逆補正
'leftSpeed----
speedL = (dgv1.Rows(rN).Cells(col2_lon + 9).Value * 0.0036)
slipAngleL = LNheadmot - LNskihead
'Left accuracy
Lflags = (dgv1.Rows(rN).Cells(col2_lon - 3).Value) * RBset 'cm
Lhacc = (dgv1.Rows(rN).Cells(col2_lon + 4).Value) * RBset 'cm
Lpdop = (dgv1.Rows(rN).Cells(col2_lon + 13).Value) * RBset 'cm
If Lpdop > 10 Then
Dim str As String = Convert.ToString(Lpdop, 16)
Dim str0 As String = Strings.Left(str, 2)
Dim str1 As String = Strings.Right(str, 2)
str = str1 + str0
Lpdop = Convert.ToInt32(str, 16)
End If
End If
End Sub
'&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&
'=================================================================BITMAP All DATA Plotting for Trimming===========================================================================
'&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&
Private Sub plotB()
Dim rN As Integer 'Row Counter
Dim RNlon0, RNlat0 As Integer
Dim bi, bj, bk As Integer
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
'----------------------Graphic Object declaration----------------------------
'If PictureBox1.Image Is Nothing Then '初回だけＢＩＴＭＡＰを定義する
' Dim bmp1X As Integer = 50000
' Dim bmp1Y As Integer = 20000
' bmap1 = New Bitmap(bmp1X, bmp1Y) ', PixelFormat.Format8bppIndexed)
'End If
'Dim bmap2 As Bitmap = New Bitmap(PictureBox1.Width, PictureBox1.Height)
'bmap2.MakeTransparent(Color.Black)
'Dim g1 As Graphics = Graphics.FromImage(bmap1)
'Dim g2 As Graphics = Graphics.FromImage(bmap2)
Dim BP1 As New Pen(Color.Red, 1)
Dim BP2 As New Pen(Color.LawnGreen, 1)
Dim BP3 As New Pen(Color.Black)
'g1.DrawRectangle(BP1, 100, 0, 300, 200)
'-----Turn Data Plot parameters-----------------------------------
Dim scale As Single
Dim tRNlon(1000) As Integer
Dim tRNlat(1000) As Integer
Dim tRNheight(1000) As Integer
Dim tRNrelN(1000) As Integer
Dim tRNrelE(1000) As Integer
Dim tRNrelD(1000) As Integer
'left data reading
Dim tLNlon(1000) As Integer
Dim tLrNlat(1000) As Integer
Dim tLNheight(1000) As Integer
Dim tLNrelN(1000) As Integer
Dim tLNrelE(1000) As Integer
Dim tLNrelD(1000) As Integer
'==============================ski data plot==============================
colNo() 'dgv header colNo合わせ
Nutral() 'TURN CUTTER でNutralポイント配列作成
'TurnNumber selection-------------------
'turnNoR,turnNoL
Dim strN As Integer = Val(TextBox4.Text)
Dim endrN As Integer = Val(TextBox5.Text)
Dim stNum As Integer = Val(TextBox16.Text)
Dim endNum As Integer = Val(TextBox17.Text)
'1turn のみの場合は次のNutralポイントがendrN
'If stNum = endNum Then
' strN = turnNoR(stNum)
' endrN = turnNoR(stNum + 1)
'Else '２個以上のターンの場合
' strN = turnNoR(stNum)
' endrN = turnNoR(endNum)
'End If
'-------------------------------------------
'===========================data Cal LOOP=================================
maxX = 0
minX = 1000000
maxY = 0
minY = 1000000
maxX2 = 0
minX2 = 1000000
maxY2 = 0
minY2 = 1000000
Dim startPX, startPY, endPX, endPY As Integer
Dim startPX2, startPY2, endPX2, endPY2 As Integer
'--基準点決め----------
'Debug.Print("plotB 1st GETPOS")
GetPos(strN)
'RNlon0 = RNlon
'RNlat0 = RNlat
'---------------------------------------------------------------------------------------------
'---------Rotate Angle----------------------------------------------------------------------
'---TextBox4,5の範囲データではstrNから一番近いNutralR()とendrNに一番手前のNutralR()を探す---
Dim startNutralNo As Integer = 0
Dim endNutralNo As Integer = 0
Dim inutral As Integer
For inutral = strN To endrN
If (NutralR(inutral) = 1 Or NutralR(inutral) = -1) And (startNutralNo = 0) Then
startNutralNo = inutral
End If
Next
For inutral = endrN To strN Step -1
If (NutralR(inutral) = 1 Or NutralR(inutral) = -1) And (endNutralNo = 0) Then
endNutralNo = inutral
End If
Next
'-------------------------------------------------------------------------------------
'変換用座標
'Debug.Print("plotB 2nd GETPOS")
GetPos(startNutralNo) 'SartNo Position Nlon,Nlat,NHeight,NrelN,NrelE,NrelD get
startPX = RNlon 'Right base start X
startPY = RNlat 'Right base start Y
startPX2 = LNlon 'Left base start X
startPY2 = LNlat 'Ledt bases start Y
'Debug.Print("plotB 3rd GETPOS")
GetPos(endNutralNo) 'endNo Position
endPX = RNlon
endPY = RNlat
endPX2 = LNlon
endPY2 = LNlat
'strNとendrNの傾斜角-------------------------------------------------
'Dim thetaL As Double
thetaRb = Math.Atan((endPY - startPY) / (endPX - startPX))
'thetaL = Math.Atan((endPY2 - startPY2) / (endPX2 - startPX2))
If CheckBox25.Checked = False Then
thetaRb = 0
'thetaL = 0
End If
TextBox15.Text = CStr(thetaRb * 180 / Math.PI)
Dim Sinth As Double = Math.Sin(-thetaRb)
Dim Costh As Double = Math.Cos(-thetaRb)
'Dim Sinth2 As Double = Math.Sin(-thetaL)
'Dim Costh2 As Double = Math.Cos(-thetaL)
'ソースBITMAPデータの配列再定義
ReDim RX(endrN - strN + 10)
ReDim RY(endrN - strN + 10)
ReDim LX(endrN - strN + 10)
ReDim LY(endrN - strN + 10)
'---Data Size Detection Loop maxX minX maxY minY-----------------------------------------------------------------------------------------------------------
rScale = 1
pcount = 0
For rN = strN To endrN
' scale = HScrollBar1.Value / 10
'---------------------1st Pass Data form Dgv1-------------------------
'Debug.Print("plotB 4th GETPOS")
GetPos(rN) 'Nlon,Nlat,NHeight,NrelN,NrelE,NrelD get
'--Right Ski---------------
pxb = CInt((RNlon * Costh - RNlat * Sinth) * rScale) ' theata だけ座標回転
pyb = CInt((RNlon * Sinth + RNlat * Costh) * rScale) ' theata だけ座標回転
pxr = CInt(((RNlon + RNrelE) * Costh - (RNlat + RNrelN) * Sinth) * rScale) ' theata だけ座標回転
pyr = CInt(((RNlon + RNrelE) * Sinth + (RNlat + RNrelN) * Costh) * rScale) ' theata だけ座標回転
'RichTextBox2.AppendText("Right:rN=" + CStr(rN) + "pxb=" + CStr(pxb) + "pyb=" + CStr(pyb) + "pxr=" + CStr(pxr) + "pyr=" + CStr(pyr) + vbCrLf)
'--Ledt Ski----------------
pxb2 = CInt((LNlon * Costh - LNlat * Sinth) * rScale) ' theata だけ座標回転
pyb2 = CInt((LNlon * Sinth + LNlat * Costh) * rScale) ' theata だけ座標回転
pxr2 = CInt(((LNlon + LNrelE) * Costh - (LNlat + LNrelN) * Sinth) * rScale) ' theata だけ座標回転
pyr2 = CInt(((LNlon + LNrelE) * Sinth + (LNlat + LNrelN) * Costh) * rScale) ' theata だけ座標回転
'RichTextBox2.AppendText("Ledt:rN=" + CStr(rN) + "pxb2=" + CStr(pxb2) + "pyb2=" + CStr(pyb2) + "pxr2=" + CStr(pxr2) + "pyr2=" + CStr(pyr2) + vbCrLf)
'配列に記憶
'Dim p As New Pen(Color.Red)
'p.Width = 3
'g1.DrawLine(p, pxb, pyb, pxr, pyr)
'------Right max min 簡易IF文
maxX = If(maxX < pxb, pxb, maxX)
maxY = If(maxY < pyb, pyb, maxY)
minX = If(minX < pxb, minX, pxb)
minY = If(minY < pyb, minY, pyb)
'Debug.Print("rN=" + CStr(rN) + ",RNlon=" + CStr(RNlon) + ",RNlat=" + CStr(RNlat) + ",pxb=" + CStr(pxb) + ",pyb=" + CStr(pyb) + ",maxX=" + CStr(maxX) + ",maxY" + CStr(maxY) + ",minX=" + CStr(minX) + ",minY=" + CStr(minY))
'---------Left max min簡易IF文
maxX2 = If(maxX2 < pxb2, pxb2, maxX2)
maxY2 = If(maxY2 < pyb2, pyb2, maxY2)
minX2 = If(minX2 < pxb2, minX2, pxb2)
minY2 = If(minY2 < pyb2, minY2, pyb2)
'Debug.Print("rN=" + CStr(rN) + ",LNlon=" + CStr(LNlon) + ",LNlat=" + CStr(LNlat) + ",pxb2=" + CStr(pxb2) + ",pyb2=" + CStr(pyb2) + ",maxX2=" + CStr(maxX2) + ",maxY2" + CStr(maxY2) + ",minX2=" + CStr(minX2) + ",minY2=" + CStr(minY2))
If rN = strN Then
startPX = pxb
startPY = pyb
startPX2 = pxb2
startPY2 = pyb2
End If
If rN = endrN Then
endPX = pxb
endPY = pyb
endPX2 = pxb2
endPY2 = pyb2
End If
pcount += 1
Next rN
'-------------------------------------------------------------------------------------------------------------------
'======max min 比較=======================
maxX = Math.Max(maxX, maxX2)
maxY = Math.Max(maxY, maxY2)
minX = Math.Min(minX, minX2)
minY = Math.Min(minY, minY2)
'--LR Total Average Range cal-------------------------
aveX = CInt((maxX + minX) / 2)
aveY = CInt((maxY + minY) / 2)
'bitmapデータのXYドット数1cm分解能（最大数）
rangeX = maxX - minX
rangeY = maxY - minY
ReDim Fy(rangeX) 'Fy()をX軸ドット数で再定義
' Debug.Print("======Result:rangeX=" + CStr(rangeX) + ",rangeY=" + CStr(rangeY) + ",aveX=" + CStr(aveX) + ",aveY=" + CStr(aveY))
'----------------------------
TextBox16.Text = CStr(rangeX) 'Lon Widht cm
TextBox17.Text = CStr(rangeY) 'Lati Height cm
'---AUTO SCALING： 元矩形がPictureBOX1のサイズに収まるように縮小サイズ決める--------------------------------------
Dim Ascale As Double
Dim rScaleX As Double = PictureBox1.Width / rangeX
Dim rScaleY As Double = PictureBox1.Height / rangeY
If rScaleX < rScaleY Then 'ソース矩形の高さ比が幅比より小さいなら
Ascale = rScaleX
Else
Ascale = rScaleY
End If
If RadioButton10.Checked = True Then
TextBox14.Visible = True
Else
TextBox14.Visible = False
End If
' Debug.Print("aveX=" + CStr(aveX) + ",aveY=" + CStr(aveY) + ",maxX=" + CStr(maxX) + ",maxY=" + CStr(maxY) + ",minX=" + CStr(minX) + ",minY=" + CStr(minY) + vbCrLf)
' Debug.Print("Ascale=" + CStr(Ascale) + "rangeX=" + CStr(rangeX) + ",rangeY=" + CStr(rangeY))
'----rScale selection-----------------------------
'rScaleとは、dot/cmで縮小率
If RadioButton8.Checked = True Then
rScale = 1
ElseIf RadioButton9.Checked = True Then 'scale SlideBar
rScale = Val(TextBox1.Text)
ElseIf RadioButton10.Checked = True Then
rScale = Ascale
End If
'---- rScale 強制固定---
rScale = 0.4
Dim dpc As Double = 1 / rScale
Label38.Text = dpc.ToString("0.000") + "cm/dot"
'H,VスクロールバーへrScaleをかけたrangeX
HScrollBar3.Maximum = rangeX * rScale
HScrollBar3.Minimum = 0
HScrollBar3.Value = 0
VScrollBar1.Maximum = rangeY * rScale
VScrollBar1.Minimum = 1
VScrollBar1.Value = 1
Dim rangesizeX As Integer = CInt(rangeX * rScale)
'axis(rangesizeX)
''''Exit Sub
'******ソースBITMAP　bmap1 定義******************************************************************************************************************
Dim bmp1X As Integer = CInt(rangeX * rScale) '20000
Dim bmp1Y As Integer = CInt(rangeY * rScale) '10000
bmap1 = New Bitmap(bmp1X, bmp1Y) ', PixelFormat.Format8bppIndexed)
Dim g1 As Graphics = Graphics.FromImage(bmap1)
'=======================================================================
'---------ソースBITMAP作成　bmap1へg1を使ってPLOT --------------------------
'=======================================================================
'Debug.Print("rNo,RX,RY,LX,LY")
Dim bmap1Width As Integer = CInt(rangeX * rScale)
Dim bmap1Height As Integer = CInt(rangeY * rScale)
Dim bmap1Byte As Double = (bmap1Width * bmap1Height * 3) / 1000000
' Label44.Text = "Source bmap1 size:" + vbCrLf + "rScale=" + CStr(rScale) + vbCrLf + "Width=" + CStr(bmap1Width) + "dot" + vbCrLf + "Height=" + CStr(bmap1Height) + vbCrLf + "MByte=" + CStr(bmap1Byte)
Label30.Text = "Source bmap1 size:" + vbCrLf + "rScale=" + CStr(rScale) + vbCrLf + "Width=" + CStr(bmap1Width) + "dot" + vbCrLf + "Height=" + CStr(bmap1Height) + vbCrLf + "MByte=" + CStr(bmap1Byte)
For rN = strN To endrN
' scale = HScrollBar1.Value / 10
Dim rNo As Integer = rN - strN
'---------------------1st Pass Data form Dgv1-------------------------
Debug.Print("plotB 5th GETPOS")
GetPos(rN) 'Nlon,Nlat,NHeight,NrelN,NrelE,NrelD get
''--Right Ski　左右全体のXY中央値でセンター振り分けで描画、回転は右角度-----------------------------------------------------------
'pxb = CInt((RNlon * Costh - RNlat * Sinth)) - aveX ' theata だけ座標回転
'pyb = CInt((RNlon * Sinth + RNlat * Costh)) - aveY ' theata だけ座標回転
'pxr = CInt(((RNlon + RNrelE) * Costh - (RNlat + RNrelN) * Sinth)) - aveX ' theata だけ座標回転
'pyr = CInt(((RNlon + RNrelE) * Sinth + (RNlat + RNrelN) * Costh)) - aveY ' theata だけ座標回転
'--1個前保存-----------------------
pxb_1 = pxb
pyb_1 = pyb
pxr_1 = pxr
pyr_1 = pyr
pxb2_1 = pxb2
pyb2_1 = pyb2
pxr2_1 = pxr2
pyr2_1 = pyr2
'--Rski ソースBMPへX原点からプロット
pxb = CInt((RNlon * Costh - RNlat * Sinth)) - minX ' theata だけ座標回転
' pyb = CInt((RNlon * Sinth + RNlat * Costh)) - aveY ' theata だけ座標回転
pyb = CInt((RNlon * Sinth + RNlat * Costh)) - minY ' theata だけ座標回転
pxr = CInt(((RNlon + RNrelE) * Costh - (RNlat + RNrelN) * Sinth)) - minX ' theata だけ座標回転
'pyr = CInt(((RNlon + RNrelE) * Sinth + (RNlat + RNrelN) * Costh)) - aveY ' theata だけ座標回転
pyr = CInt(((RNlon + RNrelE) * Sinth + (RNlat + RNrelN) * Costh)) - minY ' theata だけ座標回転
''--Left Ski　左右全体のXY中央値でセンター振り分けで描画、回転は右角度------------------------
'pxb2 = CInt((LNlon * Costh - LNlat * Sinth)) - aveX ' theata だけ座標回転
'pyb2 = CInt((LNlon * Sinth + LNlat * Costh)) - aveY ' theata だけ座標回転
'pxr2 = CInt(((LNlon + LNrelE) * Costh - (LNlat + LNrelN) * Sinth)) - aveX ' theata だけ座標回転
'pyr2 = CInt(((LNlon + LNrelE) * Sinth + (LNlat + LNrelN) * Costh)) - aveY ' theata だけ座標回転
'--Rski ソースBMPへX原点からプロット
pxb2 = CInt((LNlon * Costh - LNlat * Sinth)) - minX ' theata だけ座標回転
'pyb2 = CInt((LNlon * Sinth + LNlat * Costh)) - aveY ' theata だけ座標回転
pyb2 = CInt((LNlon * Sinth + LNlat * Costh)) - minY ' theata だけ座標回転
'座標位置とデータ関連付け配列
pbxrNL(pxb2) = rN
pbyrNL(pxb2) = pyb2
pxr2 = CInt(((LNlon + LNrelE) * Costh - (LNlat + LNrelN) * Sinth)) - minX ' theata だけ座標回転
'pyr2 = CInt(((LNlon + LNrelE) * Sinth + (LNlat + LNrelN) * Costh)) - aveY ' theata だけ座標回転
pyr2 = CInt(((LNlon + LNrelE) * Sinth + (LNlat + LNrelN) * Costh)) - minY ' theata だけ座標回転
'--Right Ski Scale adjust----
pxb = pxb * rScale '+ 800
'pyb = PictureBox1.Height / 2 - pyb * rScale
pyb = pyb * rScale
pxr = pxr * rScale '+ 800
'pyr = PictureBox1.Height / 2 - pyr * rScale
pyr = pyr * rScale
' RichTextBox2.AppendText("rN=" + CStr(rN) + "pxb=" + CStr(pxb) + "pyb=" + CStr(pyb) + "pxr=" + CStr(pxr) + "pyr=" + CStr(pyr) + vbCrLf)
'--Left Ski Scale adjust----
pxb2 = pxb2 * rScale '+ 800
'pyb2 = PictureBox1.Height / 2 - pyb2 * rScale
pyb2 = pyb2 * rScale
pxr2 = pxr2 * rScale '+ 800
'pyr2 = PictureBox1.Height / 2 - pyr2 * rScale
pyr2 = pyr2 * rScale
'RichTextBox2.AppendText(",rN=" + CStr(rN) + "pxb2=" + CStr(pxb2) + "pyb2=" + CStr(pyb2) + "pxr2=" + CStr(pxr2) + "pyr2=" + CStr(pyr2) + vbCrLf)
'=============座標位置とデータ関連付け配列==================================================
pbxrNR(pxb) = rN
pbyrNR(pxb) = pyb
lastpbxrNR = pxb
Debug.Print("pbxrNR(" + CStr(pxb) + ")=" + CStr(pbxrNR(pxb)))
'============ベース配列へ記憶==========================
RX(rNo) = pxb
RY(rNo) = pyb
LX(rNo) = pxb2
LY(rNo) = pyb2
Fy(pxb) = pyb 'pxbからpybが判る関数
Debug.Print("rScale=" + CStr(rScale) + "rN=" + CStr(rN) + ",pxb=" + CStr(pxb) + ",pxb2=" + CStr(pxb2) + ",pyb=" + CStr(pyb) + ",pyb2=" + CStr(pyb2))
Debug.Print("rN=," + CStr(rNo) + ",RX(" + CStr(rNo) + ")=," + CStr(RX(rNo)) + ",RY=," + CStr(RY(rNo)) + ",LX=," + CStr(LX(rNo)) + ",LY=," + CStr(LY(rNo)) + ",Fy(" + CStr(pxb) + ")=," + CStr(Fy(pxb)))
'==============Right Ski PLot================================
If CheckBox12.Checked = True And Math.Abs(NutralR(rN)) = 1 Then 'Nutral plot Mode
g1.FillEllipse(Brushes.LawnGreen, pxb, pyb, 10, 10)
g1.FillEllipse(Brushes.Red, pxr, pyr, 10, 10)
Else 'Not Nutral mode
g1.FillEllipse(Brushes.LawnGreen, pxb, pyb, 3, 3)
g1.FillEllipse(Brushes.Red, pxr, pyr, 4, 4)
End If
'g1.FillEllipse(Brushes.LawnGreen, pxb, pyb, 3, 3) 'draw to bap1
'g1.FillEllipse(Brushes.Red, pxr, pyr, 3, 3) 'draw to bmap1
If CheckBox3.Checked = True Then
Dim p1 As New Pen(Color.Red, 2)
'p1.Color = Color.Red
'p1.Width = 3
g1.DrawLine(p1, pxb, pyb, pxr, pyr) 'length
End If
'Debug.Print("RPlot:rN=" + CStr(rN) + ",RNlon=" + CStr(RNlon) + ",RNlat=" + CStr(RNlat) + ",pxb=" + CStr(pxb) + ",pyb=" + CStr(pyb) + ",maxX=" + CStr(maxX) + ",maxY" + CStr(maxY) + ",minX=" + CStr(minX) + ",minY=" + CStr(minY))
'==============LEft Ski PLot================================
If CheckBox12.Checked = True And Math.Abs(NutralL(rN)) = 1 Then 'Nutral plot Mode
g1.FillEllipse(Brushes.Aqua, pxb2, pyb2, 10, 10)
g1.FillEllipse(Brushes.Yellow, pxr2, pyr2, 10, 10)
Else
g1.FillEllipse(Brushes.Aqua, pxb2, pyb2, 3, 3)
g1.FillEllipse(Brushes.Yellow, pxr2, pyr2, 4, 4)
End If
'g1.FillEllipse(Brushes.Aqua, pxb2, pyb2, 3, 3) 'draw to bap1
'g1.FillEllipse(Brushes.Yellow, pxr2, pyr2, 3, 3) 'draw to bmap1
If CheckBox3.Checked = True Then
Dim p2 As New Pen(Color.LawnGreen, 2)
'p2.Color = Color.LawnGreen
'p2.Width = 3
g1.DrawLine(p2, pxb2, pyb2, pxr2, pyr2) 'length
End If
'Debug.Print("LPlot:rN=" + CStr(rN) + ",LNlon=" + CStr(LNlon) + ",LNlat=" + CStr(LNlat) + ",pxb2=" + CStr(pxb2) + ",pyb2=" + CStr(pyb2) + ",maxX2=" + CStr(maxX2) + ",maxY2" + CStr(maxY2) + ",minX2=" + CStr(minX2) + ",minY2=" + CStr(minY2))
'=====TRACEMODE =========================================
If CheckBox9.Checked = True And rN > strN + 5 Then 'Trace mode
'If delFlag = 1 Then ' delBold() Call
' Dim p0 As New Pen(Color.Black, 3)
' p0.Color = Color.Black
'End If
Dim p3 As New Pen(Color.Red, 1)
p3.DashStyle = DashStyle.Dash
g1.DrawLine(p3, pxb, pyb, pxb_1, pyb_1)
g1.DrawLine(p3, pxr, pyr, pxr_1, pyr_1)
'Debug.Print("TraceSlide:pxb=" + CStr(pxb) + ",pxb_1=" + CStr(pxb_1) + ",pyb=" + CStr(pyb) + ",pyb_1=" + CStr(pyb_1))
'Dim p4 As New Pen(Color.Magenta, 1)
'p4.DashStyle = DashStyle.Dash
'g1.DrawLine(p4, pxb, pyb, pxb_1, pyb_1)
'p4.Color = Color.Red
'g1.DrawLine(p4, pxr, pyr, pxr_1, pyr_1)
' p.Width = 1 'Kbold
Dim p5 As New Pen(Color.LawnGreen, 1)
p5.DashStyle = DashStyle.Dash
g1.DrawLine(p5, pxb2, pyb2, pxb2_1, pyb2_1)
p5.Color = Color.GreenYellow
g1.DrawLine(p5, pxr2, pyr2, pxr2_1, pyr2_1)
End If
Next rN
'---Fy(x)補完------------------
FyHokan()
'=========デバッグ用bmap1範囲枠カラー表示=========================================================================
If CheckBox28.Checked = True Then
'==================Dymmy Rectangles PLOT===============================
'YMCK Color Rectangles Full Width Full Height
'=====================================================================
Dim p6 As New Pen(Color.White, 1)
g1.DrawRectangle(p6, 0, 0, rangeX * rScale, rangeY * rScale) '切り取った矩形の外枠を赤線で描画
p6.Color = Color.Cyan
g1.DrawRectangle(p6, 50, 50, rangeX * rScale - 100, rangeY * rScale - 100) '切り取った矩形の外枠を赤線で描画
p6.Color = Color.Magenta
g1.DrawRectangle(p6, 100, 100, rangeX * rScale - 200, rangeY * rScale - 200) '切り取った矩形の外枠を赤線で描画
p6.Color = Color.Yellow
g1.DrawRectangle(p6, 150, 150, rangeX * rScale - 300, rangeY * rScale - 300) '切り取った矩形の外枠を赤線で描画
End If
g1.Dispose()
PictureBox1.Image = bmap1 ' plotb ソースBITMAP完了
'座標値とデータ関連付け穴埋め
For i = 1 To lastpbxrNR 'pbxrNR(0)=startRow
If pbxrNR(i) = 0 Then
pbxrNR(i) = pbxrNR(i - 1)
Else
pbxrNR(i) = pbxrNR(i)
End If
'Debug.Print("pbxrNR(" + CStr(i) + ")=" + CStr(pbxrNR(i)))
Next
'************************************************************************************************************************************
'ソースBITMAP bmap1にプロットした座標から最小二乗法して傾きと切片を求める
bitXlinear()
'If CheckBox26.Checked = True Then
'End If
'Bmp1_Trim(1000)
pxb_1 = pxb
pyb_1 = pyb
pxr_1 = pxr
pyr_1 = pyr
turntable() ' Turn table making for plotB
End Sub 'plotB end
'--------------------Fy(X)補完------------------------------------------
Private Sub FyHokan()
Dim i, j, y0, yN0, y1, yN1, Flag0, Flag1, delta, deltaN, dStep As Integer
Dim dStp As Double
j = 0
For i = 0 To rangeX
'Debug.Print("ForLoop:Fy(" + CStr(i) + ")=" + CStr(Fy(i)))
If Fy(i) > 0 And Flag0 = 0 And Flag1 = 0 Then
y0 = Fy(i)
yN0 = i
Flag0 = 1
ElseIf Fy(i) > 0 And Flag0 = 1 And Flag1 = 0 Then
y1 = Fy(i)
yN1 = i
Flag1 = 1
End If
If Flag0 = 1 And Flag1 = 1 Then
delta = y1 - y0
deltaN = yN1 - yN0 + 1
dStp = delta / deltaN
For j = yN0 + 1 To yN1 - 1
Dim wa As Double = Fy(j - 1) + dStp
Fy(j) = wa 'Math.Ceiling(wa)
'Debug.Print("Hokan:j=," + CStr(j) + "dStp= " + CStr(dStp) + ",y0=," + CStr(y0) + ",y1=," + CStr(y1) + "wa=" + CStr(wa) + ",Fy(" + CStr(j) + ")=," + CStr(Fy(j)))
Next j
i = j - 1
Flag0 = 0
Flag1 = 0
End If
Next i
End Sub
'=====================HscrollBar3のSlideValとrNの配列を作成=================================
'svalaは、ソースBITMAPのX座標のhScrollBar3の値
Private Function SlideVal_rN(ByVal sval As Integer) As Integer
'ドット配列RX(rN)からrNを逆引き検索
Dim ik As Integer
Dim strN As Integer = Val(TextBox4.Text)
Dim endN As Integer = Val(TextBox5.Text)
Dim endNo As Integer = endN - strN
Dim rNreturn As Integer
For ik = 0 To endNo - 1
' Debug.Print("****rNreturn=" + CStr(rNreturn) + "sval=" + CStr(sval) + ",RX()=" + CStr(RX(ik)) + "-" + CStr(RX(ik + 1)) + "****")
If sval >= RX(ik) And sval <= RX(ik + 1) Then
rNreturn = ik + 1 + strN
'Debug.Print("****rNreturn=" + CStr(rNreturn) + "sval=" + CStr(sval) + ",RX()=" + CStr(RX(ik)) + "-" + CStr(RX(ik + 1)) + "****")
ik = endNo - 1
Else
rNreturn = endN
End If
Next
Return rNreturn
End Function
'=====================BITMAP X座標とデータ番号rNの線形計算===================================
Sub bitXlinear()
Dim XrN_slope, Xrn_inter As Double
Dim strN As Integer = Val(TextBox4.Text)
Dim endN As Integer = Val(TextBox5.Text)
Dim endNo As Integer = endN - strN
Dim rNave, rNsum As Double
Dim RXave, RXsum As Double
Dim devsum1, devsum2 As Double
Dim i As Integer
rNsum = 0
RXsum = 0
devsum1 = 0
devsum2 = 0
'最小二乗法計算
For i = 0 To endNo
rNsum = rNsum + i + 1 'rNo=i
RXsum = RXsum + RX(i)
Next
rNave = rNsum / (endNo + 1)
RXave = RXsum / (endNo + 1)
For i = 0 To endNo
devsum1 = devsum1 + (i + 1 - rNave) * (RX(i) - RXave)
devsum2 = devsum2 + (RX(i) - RXave) * (RX(i) - RXave)
Next
Dim a As Double = devsum1 / devsum2
Dim b As Double = rNave - a * RXave
TextBox11.Text = Val(a)
TextBox12.Text = 0
End Sub
'============================================================================================---
'==================================================================================================================================================================================
'--plob:ソース画像を切り取る位置を水平スクロールバー３で決めて描画
'===================================================================================================================
Private Sub HScrollBar3_ValueChanged(sender As Object, e As EventArgs) Handles HScrollBar3.ValueChanged
Dim SlideVal As Integer = HScrollBar3.Value
Debug.Print("start====SlideVal=" + CStr(SlideVal))
If SlideVal < SlideVal_1 Then
Slideplus = 0
Else
Slideplus = 1
End If
'Debug.Print("Scrolbar3change 1st getpos")
PictureBox1.Image = Nothing
MoveGraph()
SlideVal_1 = SlideVal
TextBox7.Text = CStr(SlideVal)
TextBox21.Text = CStr(pbxrNR(SlideVal))
'============grfBitmapへカーソル描画==========================
If PictureBox2.Visible = True Then
'---------------------カーソル座標計算---------------------------------
Dim startRow As Integer = Val(TextBox4.Text)
Dim endRow As Integer = Val(TextBox5.Text)
Dim rNdiv As Double = CDbl(PictureBox2.Width / (endRow - startRow))
Dim CursorPointX As Integer = Int((pbxrNR(SlideVal) - startRow) * rNdiv)
'---------------------------------------------------------------
Debug.Print("Scrollba3 changed:CursorPointX=" + CStr(CursorPointX) + "pbxrNR(Slidval)=" + CStr(pbxrNR(SlideVal)) + "SlideVal=" + CStr(SlideVal))
Dim gc As Graphics = Graphics.FromImage(cursorBitmap)
gc.FillRectangle(Brushes.Black, 0, 0, PictureBox2.Width, PictureBox2.Height)
Dim srcRect As New Rectangle(0, 0, PictureBox2.Width, PictureBox2.Height) 'ソースから切り取る四角の定義
Dim desRect As New Rectangle(0, 0, PictureBox2.Width, PictureBox2.Height) '切り取った四角を貼りこむ四角の定義=>今回はソースと同じサイズなので等倍コピー
gc.DrawImage(grfBitmap, desRect, srcRect, GraphicsUnit.Pixel) 'grfBitmapを丸ごとコピー　cursorBitmapへ
'だめなので黒塗り
Dim pCursor As New Pen(Color.White, 2)
gc.DrawLine(pCursor, CursorPointX, 0, CursorPointX, PictureBox2.Height)
'Debug.Print("CursorPointX=" + CStr(CursorPointX))
'------------------------カーソル横文字表示-----------------------
GetPos(pbxrNR(SlideVal))
Dim fntR As New Font("MS UI Gothic", 10, FontStyle.Bold)
'Right ski data
gc.DrawString("SpeedR=" + (speedR).ToString("##.#kmh"), fntR, Brushes.DeepPink, CursorPointX + 3, 185)
gc.DrawString("SlipAngR=" + (slipAngleR).ToString("##.#deg"), fntR, Brushes.Orange, CursorPointX + 3, 205)
gc.DrawString("HeadMotR=" + (RNheadmot).ToString("##.#deg"), fntR, Brushes.Red, CursorPointX + 3, 225)
'Left ski data
gc.DrawString("SpeedL=" + (speedL).ToString("##.#kmh"), fntR, Brushes.RoyalBlue, CursorPointX + 3, 125)
gc.DrawString("SlipAngL=" + (slipAngleL).ToString("##.#deg"), fntR, Brushes.Aqua, CursorPointX + 3, 145)
gc.DrawString("HeadMotL=" + (LNheadmot).ToString("##.#deg"), fntR, Brushes.LawnGreen, CursorPointX + 3, 165)
' gc.DrawString("平均斜度=" + (thetaRb * 57.2957795).ToString("##.#"), fntR, Brushes.White, 1100, 220) 'コース全体の傾き角
'---------------------------------------------------------
gc.Dispose()
End If
PictureBox2.Image = Nothing
PictureBox2.Image = cursorBitmap
Debug.Print("end===SlideVal=" + CStr(SlideVal))
End Sub
Private Sub MoveGraph()
Dim SlideVal As Integer = HScrollBar3.Value
Dim vy As Integer = VScrollBar1.Value
'SlideVal 座標値からデータ行番号rNlinを線形計算
Dim xdism As Double = SlideVal / rScale / 100
TextBox13.Text = xdism.ToString("0.00") + "m"
'Dim rNlin As Integer = CInt(Val(TextBox11.Text) * SlideVal + Val(TextBox12.Text) + Val(TextBox4.Text))
Dim rNlin = SlideVal_rN(SlideVal)
TextBox10.Text = CStr(rNlin)
Dim ydism As Double = vy / rScale / 100
TextBox20.Text = ydism.ToString("0.00") + "m"
mouseFlag = 0
'画像を動かすソースBITMAP座標　bmap1 X:SlideVal dot Y:vy dot
If CheckBox27.Checked = True Then
Bmp1_FixTrim(SlideVal, rNlin) 'Fy中央先端固定モード
Else
Bmp1_Trim(SlideVal, vy) 'Y座標レンジ固定
End If
' RTKdataText(rNlin)
End Sub
'****************************************************************************************************
'*****************ソース画像切り取りサブBMP1_Trim()*************************************************************
'****************************************************************************************************
Private Sub Bmp1_Trim(ByVal SlideVal As Integer, ByVal verticalY As Integer)
'------------------------------------------------------------------------------------------------
'-----HscrollBar値で切り取り前進動画-------------------------------------------------------------
'------------------------------------------------------------------------------------------------
Dim BP1 As New Pen(Color.Red, 1)
Dim BP2 As New Pen(Color.LawnGreen, 1)
Dim BP3 As New Pen(Color.Black)
Dim scrollN As Integer = Math.Truncate(SlideVal / PictureBox1.Width)
Dim cWidth As Integer = SlideVal Mod PictureBox1.Width
'Dim srcRect As New Rectangle(PictureBox1.Width * scrollN, 0, cWidth, rangeY) '切り取り部分定義
Dim srcRect As New Rectangle(PictureBox1.Width * scrollN, 0, cWidth, 600) '切り取り部分定義
Dim desRect As New Rectangle(0, verticalY, srcRect.Width, srcRect.Height)
'Debug.Print("StartNo=" + CStr(PictureBox1.Width * scrollN) + ",cWidth=" + CStr(cWidth) + ",SlideVal=" + CStr(SlideVal) + ",scrollN=" + CStr(scrollN))
'Dim desRect As New Rectangle(0, 0, PictureBox1.Width, PictureBox1.Height)
bmap2 = New Bitmap(PictureBox1.Width, PictureBox1.Height)
g2 = Graphics.FromImage(bmap2)
g2.DrawImage(bmap1, desRect, srcRect, GraphicsUnit.Pixel) 'bmap1から指定サイズで切り取ってg2:bmap2へ書き込む
'g2.DrawRectangle(BP1, 0, 0, srcRect.Width, srcRect.Height) '切り取った矩形の外枠を赤線で描画
'g1.Dispose()
g2.Dispose()
'Y軸を１８０度回転させて上下反転して上を北に変更
bmap2.RotateFlip(RotateFlipType.Rotate180FlipX)
PictureBox1.Image = bmap2 'bmap2を表示
'================================================================
'RichTextBox2.AppendText("maxX=" + CStr(maxX) + "maxY=" + CStr(maxY) + "minX=" + CStr(minX) + "minY=" + CStr(minY) + vbCrLf)
'RichTextBox2.AppendText("srcRect.width=" + CStr(srcRect.Width) + "srcRect.Height=" + CStr(srcRect.Height) + vbCrLf)
'RichTextBox2.AppendText("Ascale=" + CStr(Ascale) + "ascaleW=" + CStr(ascaleW) + "ascaleH=" + CStr(ascaleH) + vbCrLf)
'RichTextBox2.AppendText("srcRect.width*Ascale=" + CStr(CInt(srcRect.Width * Ascale)) + "srcRect.Height*Ascale=" + CStr(CInt(srcRect.Height * Ascale)) + vbCrLf)
'Debug.Print("aveX=" + CStr(aveX) + "aveY=" + CStr(aveY) + "maxX=" + CStr(maxX) + ",maxY=" + CStr(maxY) + ",minX=" + CStr(minX) + ",minY=" + CStr(minY) + vbCrLf)
'Debug.Print("srcRect.width=" + CStr(srcRect.Width) + "srcRect.Height=" + CStr(srcRect.Height) + vbCrLf)
'Debug.Print("Ascale=" + CStr(Ascale) + "ascaleW=" + CStr(ascaleW) + "ascaleH=" + CStr(ascaleH) + vbCrLf)
'Debug.Print("srcRect.width*Ascale=" + CStr(CInt(srcRect.Width * Ascale)) + "srcRect.Height*Ascale=" + CStr(CInt(srcRect.Height * Ascale)) + vbCrLf)
'------------------------------------------------------------------------------------------------------------------------------
'------------------------------------------------------------------------------------------------------------------------------
End Sub
'****************************************************************************************************************
'先端データを読んで切り取りXY座標を制御しながら先端固定モードで描画
'****************************************************************************************************************
Private Sub Bmp1_FixTrim(ByVal SlideVal As Integer, ByVal rNlin As Integer)
'------------------------------------------------------------------------------------------------
'-----HscrollBar値で切り取り前進動画-------------------------------------------------------------
'------------------------------------------------------------------------------------------------
Dim BP1 As New Pen(Color.Red, 1)
Dim BP2 As New Pen(Color.LawnGreen, 1)
Dim BP3 As New Pen(Color.Black)
Dim scrollN As Integer = Math.Truncate(SlideVal / PictureBox1.Width)
Dim cWidth As Integer = SlideVal Mod PictureBox1.Width
Dim sY As Integer
Dim dY As Integer = 0 'desRectのオフセットY位置
Dim rN As Integer = rNlin - Val(TextBox4.Text)
If Fy(SlideVal) > 200 Then
'sY = RY(rN) - 300
sY = CInt(Fy(SlideVal)) - PictureBox1.Height / 2
dY = 0
Else
sY = 0
' dY = (300 - RY(rN))
dY = PictureBox1.Height / 2 - CInt(Fy(SlideVal))
End If
currentX = CInt(PictureBox1.Width * scrollN)
currentY = sY
' Dim srcRect As New Rectangle(PictureBox1.Width * scrollN,0, cWidth, rangeY) 'Y原点スタート
Dim srcRect As New Rectangle(PictureBox1.Width * scrollN, sY, cWidth, PictureBox1.Height) '切り取り部分定義
Dim desRect As New Rectangle(0, dY, srcRect.Width, srcRect.Height)
'Debug.Print("StartNo=" + CStr(PictureBox1.Width * scrollN) + ",cWidth=" + CStr(cWidth) + ",SlideVal=" + CStr(SlideVal) + ",rNlin=" + CStr(rNlin) + ",RY=" + CStr(RY(rN)) + ",sY=" + CStr(sY))
Label43.Text = "StartNo=" + CStr(PictureBox1.Width * scrollN) + ",cWidth=" + CStr(cWidth) + ",SlideVal=" + CStr(SlideVal) + ",rNlin=" + CStr(rNlin) + ",RY=" + CStr(RY(rN)) + ",sY=" + CStr(sY) + ",dY=" + CStr(dY)
'Dim desRect As New Rectangle(0, 0, PictureBox1.Width, PictureBox1.Height)
bmap2 = New Bitmap(PictureBox1.Width, PictureBox1.Height)
g2 = Graphics.FromImage(bmap2)
g2.DrawImage(bmap1, desRect, srcRect, GraphicsUnit.Pixel) 'bmap1から指定サイズで切り取ってg2:bmap2へ書き込む
'g2.DrawRectangle(BP1, 0, 0, srcRect.Width, srcRect.Height) '切り取った矩形の外枠を赤線で描画
'Y軸を１８０度回転させて上下反転して上を北に変更
bmap2.RotateFlip(RotateFlipType.Rotate180FlipX)
'plotB画面への情報表示　精度、ターン構造体情報
Dim ctN As Integer = turnN(rNlin) '現在行でのターン番号
Dim fnt As New Font("MS UI Gothic", 14, FontStyle.Bold)
turnCalc(ctN) 'ターン番号での構造体計算　
'ターン方向direction による表示データ　色変更
If tL(ctN).direction = "Rturn" And ctN > 0 Then
g2.DrawString("TurnNo=" + CStr(ctN), fnt, Brushes.LawnGreen, 900, 220) 'ターン構造体番号
g2.DrawString("TurnDirection=" + tL(ctN).direction, fnt, Brushes.LawnGreen, 1000, 220) 'ターン構造体番号
ElseIf tR(ctN).direction = "Lturn" And ctN > 0 Then
g2.DrawString("TurnNo=" + CStr(ctN), fnt, Brushes.Red, 900, 220) 'ターン構造体番号
g2.DrawString("TurnDirection=" + tL(ctN).direction, fnt, Brushes.Red, 1000, 220) 'ターン構造体番号
Else
g2.DrawString("=====Nutral Point======", fnt, Brushes.Red, 900, 220) 'ターン構造体番号
End If
'=====================LEFT SKI============================================================================
g2.DrawString("Radius=" + (tL(ctN).Radius).ToString("#.#m"), fnt, Brushes.LawnGreen, 900, 240) 'ターン構造体番号
g2.DrawString("Aspect=" + (tL(ctN).Aspectratio).ToString("#.##"), fnt, Brushes.LawnGreen, 1050, 240) 'ターン構造体番号
'２行目　斜度　平均速度
g2.DrawString("Slope =" + (tL(ctN).Slopedeg).ToString("#.#deg "), fnt, Brushes.LawnGreen, 900, 260) 'ターン構造体番号
g2.DrawString("Speed=" + (tL(ctN).aveSpeed).ToString("#.#kmh"), fnt, Brushes.LawnGreen, 1050, 260) 'ターン構造体番号
'g2.DrawString("Aspect=" + (tR(ctN).Aspectratio).ToString("#.##"), fnt, Brushes.White, 1090, 220) 'ターン構造体番号
'3行目　最大SLIP　左
g2.DrawString("maxSlipL=" + (tL(ctN).maxSkid).ToString("#.#deg "), fnt, Brushes.LawnGreen, 900, 280) 'ターン構造体番号
'g2.DrawString("maxSlipR=" + (tR(ctN).maxSkid).ToString("#.#deg"), fnt, Brushes.Red, 1100, 280) 'ターン構造体番号
'=====================RIGHT SKI============================================================================
'g2.DrawString("TurnDirection=" + tR(ctN).direction, fnt, Brushes.Red, 900, 260) 'ターン構造体番号
g2.DrawString("Radius=" + (tR(ctN).Radius).ToString("#.#m"), fnt, Brushes.Red, 900, 300) 'ターン構造体番号
g2.DrawString("Aspect=" + (tR(ctN).Aspectratio).ToString("#.##"), fnt, Brushes.Red, 1050, 300) 'ターン構造体番号
'２行目　斜度　平均速度
g2.DrawString("Slope =" + (tR(ctN).Slopedeg).ToString("#.#deg "), fnt, Brushes.Red, 900, 320) 'ターン構造体番号
g2.DrawString("Speed=" + (tR(ctN).aveSpeed).ToString("#.#kmh"), fnt, Brushes.Red, 1050, 320) 'ターン構造体番号
'g2.DrawString("Aspect=" + (tR(ctN).Aspectratio).ToString("#.##"), fnt, Brushes.White, 1090, 220) 'ターン構造体番号
'3行目　最大SLIP　右
'g2.DrawString("maxSlipL=" + (tL(ctN).maxSkid).ToString("#.#deg "), fnt, Brushes.LawnGreen, 900, 340) 'ターン構造体番号
g2.DrawString("maxSlipR=" + (tR(ctN).maxSkid).ToString("#.#deg"), fnt, Brushes.Red, 900, 340) 'ターン構造体番号
'==========精度パラメータ表示 =======================================================
'精度パラメータ表示L
If Lflags >= 131 Then
g2.DrawString("Lflags=" + CStr(Lflags), fnt, Brushes.LawnGreen, 900, 360)
g2.DrawString("LhAcc=" + CStr(Lhacc), fnt, Brushes.LawnGreen, 1000, 360)
g2.DrawString("LPdop=" + (Lpdop / 100).ToString("#.#"), fnt, Brushes.LawnGreen, 1100, 360)
Else
g2.DrawString("Lflags=" + CStr(Lflags), fnt, Brushes.Gray, 900, 360)
g2.DrawString("LhAcc=" + CStr(Lhacc), fnt, Brushes.Gray, 1000, 360)
g2.DrawString("LPdop=" + (Lpdop / 100).ToString("#.#"), fnt, Brushes.Gray, 1100, 360)
End If
'精度パラメータ表示 R
If Rflags >= 131 Then
g2.DrawString("Rflags=" + CStr(Rflags), fnt, Brushes.Red, 900, 380)
g2.DrawString("RhAcc=" + CStr(Rhacc), fnt, Brushes.Red, 1000, 380)
g2.DrawString("RPdop=" + (Rpdop / 100).ToString("#.#"), fnt, Brushes.Red, 1100, 380)
Else
g2.DrawString("Rflags=" + CStr(Rflags), fnt, Brushes.Gray, 900, 380)
g2.DrawString("RhAcc=" + CStr(Rhacc), fnt, Brushes.Gray, 1000, 380)
g2.DrawString("RPdop=" + (Rpdop / 100).ToString("#.#"), fnt, Brushes.Gray, 1100, 380)
End If
'北緯軸傾き
g2.DrawString("NorthAxis Declined =" + (thetaRb * 57.2957795).ToString("##.#deg"), fnt, Brushes.White, 0, 380) 'コース全体の傾き角
PictureBox1.Image = bmap2 'bmap2を表示
End Sub
'TTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTT
'-----Picturebox1内に文字表示　rN Speed headMot SkidAngl DrawString表示-------------
'------------------------------------------------------------------------
Private Sub RTKdataText(ByVal rN As Integer)
Dim g3 As Graphics = Graphics.FromImage(PictureBox1.Image)
'-------------------------SKI DATA TEXT 表示-------------------------------------------------------
'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 fntR As New Font("MS UI Gothic", 14, FontStyle.Bold)
Dim fntRB As New Font("MS UI Gothic", 14, FontStyle.Bold)
If rN >= dgv1.Rows.Count Then rN = dgv1.Rows.Count
Dim skiHead As Double
speedR = (dgv1.Rows(rN).Cells(col_lon + 9).Value * 0.0036)
speedRF = Format(speedR, "##.0") + "kmh"
Dim headR_1 As Double = headR
headR = (dgv1.Rows(rN).Cells(col_lon + 10).Value * 0.00001)
'--------headR Moving Average -----------------------------------
'headR4_1 = headR4
'headR4 = 0
'For i = 0 To 1
' headR4 = headR4 + (dgv1.Rows(rN - i).Cells(col_lon + 10).Value * 0.00001)
' If rN < rN_1 And rN > 5 Then
' headR4 = headR4 + (dgv1.Rows(rN - i).Cells(col_lon + 10).Value * 0.00001)
' End If
'Next
'headR4 = headR4 / 4
'----------------------------------------------------------------
If rN > 2 Then
headR_1 = (dgv1.Rows(rN - 1).Cells(col_lon + 10).Value * 0.00001)
End If
Dim nutralC As String
If headR >= headR_1 Then
nutralC = "Rhead【"
End If
If headR < headR_1 Then
nutralC = "Lhead【"
End If
headRF = 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"
skiR = (dgv1.Rows(rN).Cells(col_lon + 24).Value * 0.00001) - skiHead
skiRF = Format(skiR, "000")
'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"
slipR_1 = slipR
slipR = headR - skiR + 180
If slipR > 100 Then
slipR = slipR_1
End If
slipRF = Format(slipR, "00") + "deg】"
Dim hAccR As Integer = dgv1.Rows(rN).Cells(col_lon + 4).Value
Dim hAccRF As String = Format(hAccR, "000")
'flags Right----------------
Dim flagsR As Integer = dgv1.Rows(rN).Cells(col_lon - 3).Value
Dim flagsRF As String = Format(flagsR, "000")
' g3.DrawString("R:" + speedRF + "：" + nutralC + headRF + "Skid【" + slipRF + "Acc:" + hAccRF + "flg:" + flagsRF, fntR, Brushes.Red, 0, 0)
'=====tR構造体内配列を使ってrNデータを細かく表示==================
' rN=iStct+ ,Speed(), Gacc(), Skid() ,hAcc , flags
Dim tNR As Integer
If NutralR(rN) = 1 Or NutralR(rN) = -1 Then
tNR = NutralR(rN + 2) - 2
Else
tNR = NutralR(rN) - 2
End If
Dim rNtR As Integer = rN - tR(tNR).startNo
g3.DrawString(CStr(tNR) + "R[" + CStr(rN) + "]" + CStr(rNtR) + "<" + (tR(tNR).Speed(rNtR)).ToString(" 00.0") + " km/h：" + (tR(tNR).Gacc(rNtR) / 9.8).ToString("0.0") + "G," + "skid" + (tR(tNR).Skid(rNtR)).ToString("00.0") + ">[hacc:" + hAccRF + "mmflg:" + flagsRF + "]", fntR, Brushes.Red, 500, 30)
RichTextBox2.AppendText("rN=" + CStr(rN) + "rNt=" + CStr(rNtR))
'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)
speedLF = Format(speedL, "##.0") + "km/h"
'Dim headL As String = Format((dgv1.Rows(rN).Cells(col2_lon + 10).Value * 0.00001), "000") + "deg"
headL_1 = headL
headL = (dgv1.Rows(rN).Cells(col2_lon + 10).Value * 0.00001)
headLF = Format(headL, "000")
'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
skiLF = Format(skiL, "000")
'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_1 = slipL
slipL = headL - skiL + 180
If slipL > 100 Then
slipL = slipL_1
End If
slipLF = Format(slipL, "00") + "deg】"
Dim nutralC2 As String
If headL >= headL_1 Then
nutralC2 = "Rhead【"
End If
If headL <headL_1 Then
nutralC2="Lhead【"
End If
headLF = Format(headL, "000") + "deg】"
Dim hAccL As Integer = dgv1.Rows(rN).Cells(col2_lon + 4).Value
Dim hAccLF As String = Format(hAccL, "000")
'flags Left----------------
Dim flagsL As Integer = dgv1.Rows(rN).Cells(col_lon - 3).Value
Dim flagsLF As String = Format(flagsL, "000")
'g3.DrawString("L:" + speedLF + "：" + nutralC2 + headLF + "Skid【" + slipLF + "Acc:" + hAccLF + "flg:" + flagsLF, fntR, Brushes.LawnGreen, 0, 20)
'g3.DrawString("L:" + speedLF + " " + headLF + " " + skiLF + " " + slipLF + " " + hAccLF + " " + flagsLF, fntR, Brushes.LawnGreen, 0, 40)
'End If
'=====tL構造体内配列を使ってrNデータを細かく表示==================
' rN=iStct+ ,Speed(), Gacc(), Skid() ,hAcc , flags
Dim tNL As Integer
If NutralL(rN) = 1 Or NutralL(rN) = -1 Then
tNL = NutralL(rN + 2) - 2
Else
tNL = NutralL(rN) - 2
End If
Dim rNtL As Integer = rN - tL(tNL).startNo
g3.DrawString(CStr(tNL) + "L[" + CStr(rN) + "]" + CStr(rNtL) + "<" + (tL(tNL).Speed(rNtL)).ToString("00.0") + "km/h：" + (tL(tNL).Gacc(rNtL) / 9.8).ToString("0.0") + "G," + "skid" + (tL(tNL).Skid(rNtL)).ToString("00.0") + ">[hacc:" + hAccRF + "mmflg:" + flagsRF + "]", fntR, Brushes.LawnGreen, 500, 80)
'==============================Turn Calc 構造体tR() tL() 表示======================================
' turnNoを行番号から検索する
Dim turni As Integer
Dim currntNo As Integer
If NutralR(rN) > 1 Then
currntNo = NutralR(rN) - 2
End If
Dim currntNo_1 As Integer = currntNo
'============dgv2のターンNo行を塗りつぶす============================================================
If currntNo > 0 And Slideplus = 1 And currntNo < tR(0).lastNo - 1 Then
dgv2.FirstDisplayedScrollingRowIndex = currntNo * 2
Dim icell As Integer
For icell = 1 To dgv2.ColumnCount - 1
dgv2(icell, currntNo * 2).Style.BackColor = Color.Yellow
dgv2(icell, currntNo * 2 + 1).Style.BackColor = Color.Yellow
Next icell
ElseIf Slideplus = 0 Then
For icell = 1 To dgv2.ColumnCount - 1
dgv2(icell, currntNo * 2).Style.BackColor = Color.Empty
dgv2(icell, currntNo * 2 + 1).Style.BackColor = Color.Empty
Next icell
End If
'=======Turn Display ===================================================
Dim fntR2 As New Font("MS UI Gothic", 20)
Dim fntL2 As New Font("MS UI Gothic", 20)
Dim outsideR, outsideL As String
Dim bR, bL As SolidBrush
If tR(currntNo).direction = "Lturn" Then
outsideR = "Outski"
fntR2 = New Font("MS UI Gothic", 12, FontStyle.Bold)
bR = New SolidBrush(Color.FromName("red"))
Else
outsideR = " In ski "
fntR2 = New Font("MS UI Gothic", 12, FontStyle.Bold)
bR = New SolidBrush(Color.FromName("red"))
End If
If tL(currntNo).direction = "Rturn" Then
outsideL = "Outski"
fntL2 = New Font("MS UI Gothic", 12, FontStyle.Bold)
bL = New SolidBrush(Color.FromName("lawngreen"))
Else
outsideL = " In ski "
fntL2 = New Font("MS UI Gothic", 12, FontStyle.Bold)
bL = New SolidBrush(Color.FromName("lawngreen"))
End If
g3.DrawString("R:turnNo" + CStr(currntNo) + "_rad" + (tR(currntNo).Radius).ToString("00.0") + "m(" + tR(currntNo).Aspectratio.ToString("0.00") + ")/skid" + (tR(currntNo).aveSkid).ToString("00.0") + "deg/" + (tR(currntNo).aveSpeed).ToString("00.0") + "km/h /" + (tR(currntNo).Gaccmax / 9.8).ToString("0.0") + "G_/slope" + (tR(currntNo).Slopedeg).ToString("00.0") + "deg", fntR2, bR, 500, 0)
g3.DrawString("L:turnNo" + CStr(currntNo) + "_rad" + (tL(currntNo).Radius).ToString("00.0") + "m(" + tL(currntNo).Aspectratio.ToString("0.00") + ")/skid" + (tL(currntNo).aveSkid).ToString("00.0") + "deg_/" + (tL(currntNo).aveSpeed).ToString("00.0") + "km/h /" + (tL(currntNo).Gaccmax / 9.8).ToString("0.0") + "G/slope" + (tL(currntNo).Slopedeg).ToString("00.0") + "deg", fntL2, bL, 500, 50)
'g3.DrawString("turnNo=" + CStr(currntNo) + "startNo=" + CStr(tR(currntNo).startNo) + "endNo=" + CStr(tR(currntNo).endNo), fntR2, Brushes.LawnGreen, 700, 50)
End Sub
'=========================Graph image Clear===================================
Private Sub Button6_Click(sender As Object, e As EventArgs) Handles Button6.Click
mouseFlag = 0
autocount = 0 ' autocounter reset
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-------------------------------------------
If CheckBox12.Checked = True And NutralR(rN) = 1 Then 'Nutral plot Mode
g.FillEllipse(Brushes.LawnGreen, pxb, pyb, 10, 10)
g.FillEllipse(Brushes.Red, pxr, pyr, 10, 10)
Else 'Not Nutral mode
g.FillEllipse(Brushes.LawnGreen, pxb, pyb, 3, 3)
g.FillEllipse(Brushes.Red, pxr, pyr, 4, 4)
End If
'Length plot Normal & Bold -----------------------------------------------------
If CheckBox3.Checked = True Then 'Length mode
If CheckBox9.Checked = True Then 'Trace mode Length color YELLOW
p.Color = Color.Red 'Color.Yellow
Else
p.Color = Color.Red
End If
If delFlag = 1 Then ' delBold() Call
p.Color = Color.Black
End If
p.Width = 3 'Kbold Length width 3
g.DrawLine(p, pxb, pyb, pxr, pyr)
End If
If CheckBox9.Checked = True And pcount > 2 Then 'Trace mode
If delFlag = 1 Then ' delBold() Call
p.Color = Color.Black
End If
p.Width = Kbold
g.DrawLine(p, pxb, pyb, pxb_1, pyb_1)
g.DrawLine(p, pxr, pyr, pxr_1, pyr_1)
p.Width = 1 'Kbold
p.Color = Color.Magenta '
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
'Line Plot------------------------------------------------------
If CheckBox19.Checked = True Then
End If
'===================================================================================================================
'==============================Text Display by DrawString()=========================================================
'===================================================================================================================
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 SkidAng hAcc flags", 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 / period) + koma0 '/ 33.367
' koma(komaRN)
'End If
'rN_1 = rN
''---dgv rN行の最上部へ頭出しして色を変える
'If Hsc4 = 1 Then
' dgv1.Rows(rN_1).DefaultCellStyle.BackColor = Color.Empty
' rN_1 = rN
' dgv1.FirstDisplayedScrollingRowIndex = rN
' dgv1.Rows(rN).DefaultCellStyle.BackColor = Color.LawnGreen
' 'Dim dum As Integer = dgv1.Rows(rN).Cells(0).Value
'End If
'*****************************************************************************************************************
'*****************************************************************************************************************
'*****************************************************************************************************************
'-------------------------------------------------------------------------------------------------
'-------------------------SKI DATA TEXT 表示-------------------------------------------------------
'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
'speedR = (dgv1.Rows(rN).Cells(col_lon + 9).Value * 0.0036)
'speedRF = Format(speedR, "##.0") + "kmh"
'headR = (dgv1.Rows(rN).Cells(col_lon + 10).Value * 0.00001)
''--------headR Moving Average -----------------------------------
'headR4_1 = headR4
'headR4 = 0
'For i = 0 To 3
' headR4 = headR4 + (dgv1.Rows(rN + i).Cells(col_lon + 10).Value * 0.00001)
' If rN < rN_1 And rN > 5 Then
' headR4 = headR4 + (dgv1.Rows(rN - i).Cells(col_lon + 10).Value * 0.00001)
' End If
'Next
'headR4 = headR4 / 4
''----------------------------------------------------------------
'If rN > 2 Then
' headR_1 = (dgv1.Rows(rN - 1).Cells(col_lon + 10).Value * 0.00001)
'End If
'headRF = Format(headR, "000")
'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"
'skiR = (dgv1.Rows(rN).Cells(col_lon + 24).Value * 0.00001) - skiHead
'skiRF = Format(skiR, "000")
''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"
'slipR_1 = slipR
'slipR = headR - skiR
'If slipR > 100 Then
' slipR = slipR_1
'End If
'slipRF = Format(slipR, "00")
'Dim hAccR As Integer = dgv1.Rows(rN).Cells(col_lon + 4).Value
'Dim hAccRF As String = Format(hAccR, "000")
''flags Right----------------
'Dim flagsR As Integer = dgv1.Rows(rN).Cells(col_lon - 3).Value
'Dim flagsRF As String = Format(flagsR, "000")
'g.DrawString("R:" + speedRF + " " + headRF + " " + skiRF + " " + slipRF + " " + hAccRF + " " + flagsRF, 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)
' speedLF = 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)
' headLF = Format(headL, "000")
' '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
' skiLF = Format(skiL, "000")
' '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_1 = slipL
' slipL = headL - skiL
' If slipL > 100 Then
' slipL = slipL_1
' End If
' slipLF = Format(slipL, "00")
' Dim hAccL As Integer = dgv1.Rows(rN).Cells(col2_lon + 4).Value
' Dim hAccLF As String = Format(hAccL, "000")
' 'flags Left----------------
' Dim flagsL As Integer = dgv1.Rows(rN).Cells(col_lon - 3).Value
' Dim flagsLF As String = Format(flagsL, "000")
' g.DrawString("L:" + speedLF + " " + headLF + " " + skiLF + " " + slipLF + " " + hAccLF + " " + flagsLF, fntR, Brushes.LawnGreen, tx0 + 8, ty0 + 34)
'End If
'/////////////////////////////////////////////////////////////////////////////////////////////////////////////////
'//////////////////////// 時系列GRAPH　プロット//////////////////////////////////////////////////////////////////
'///////////////////////////////////////////////////////////////////////////////////////////////////////////////
'If CheckBox23.Checked = True Then
' Dim G0X As Integer = 800 'グラフ左上X座標
' Dim G0Y As Integer = 360 'グラフ左上Y座標
' Dim Gwidth As Integer = 1000 'グラフ幅
' Dim Gheight As Integer = 240 'グラフ高さ
' Dim GYratio1, GYratio2, GYratio3, GYratio4, GYratio5 As Double
' Dim Galtitude As Double
' Dim GstartN As Integer = Int(TextBox4.Text)
' Dim GendN As Integer = Int(TextBox5.Text)
' Dim GdataSu As Integer = Int(TextBox5.Text) - Int(TextBox4.Text) 'TextBox5-TextBox4 データ数
' If GdataSu = 0 Then
' GdataSu = 100
' End If
' Dim Gtimeratio As Double = CDbl(Gwidth / GdataSu) '時間軸比率　横軸　ドット数/データ数
' Dim Glevel1, Glevel2, Glevel3, Glevel4, Glevel5 As Integer
' Dim psize As Integer = 1
' Dim marksize As Integer = 3 '3 plotスライドバー読み
' Dim elevationF As String
' Dim elevationN As Double
' If CheckBox18.Checked = True Then
' 'Elevation data------------------------------------------
' elevation = dgv1.Rows(rN).Cells(col_lon + 2).Value / 1000
' elevationF = Format(elevation, "0000.00")
' elevationS = dgv1.Rows(Int(TextBox4.Text)).Cells(col_lon + 2).Value / 1000
' elevationE = dgv1.Rows(Int(TextBox5.Text)).Cells(col_lon + 2).Value / 1000
' elevationR = elevationS - elevationE '標高差
' elevationN = elevation - elevationE '現在の標高差
' GYratio4 = (Gheight - 40) / elevationR 'dot/m
' Glevel4 = 240
' Gpx4_1 = Gpx4
' Gpy4_1 = Gpy4
' Gpx4 = Int((rN - GstartN) * Gtimeratio) + G0X
' Gpy4 = Int(G0Y + Glevel4 - elevationN * GYratio4)
' ' gSpeed=>speedR kmh プロット 0-60Kmh 60dot----------------------------
' GYratio1 = 6
' Glevel1 = 240
' Gpx1_1 = Gpx1
' Gpy1_1 = Gpy1
' Gpx1 = Int((rN - GstartN) * Gtimeratio) + G0X
' Gpy1 = Int(G0Y + Glevel1 - speedR * GYratio1)
' ' headMot=>headR deg プロット　0-180deg-------------------------------
' GYratio2 = 1
' Glevel2 = 240
' Gpx2_1 = Gpx2
' Gpy2_1 = Gpy2
' Gpx2 = Int((rN - GstartN) * Gtimeratio) + G0X
' Gpy2 = Int(G0Y + Glevel2 - headR * GYratio2)
' '---------------------------------------------------------------------
' ' skiR deg プロット　0-45deg-------------------------------
' GYratio3 = 1
' Glevel3 = 200
' Gpx3_1 = Gpx3
' Gpy3_1 = Gpy3
' Gpx3 = Int((rN - GstartN) * Gtimeratio) + G0X
' Gpy3 = Int(G0Y + Glevel3 - slipR * GYratio3)
' '----------------------------------------------------------------------
' 'Differential headR-headR_1 プロット 0-10deg------------------------------------------
' GYratio5 = 3
' Glevel5 = 240
' Gpx5_1 = Gpx5
' Gpy5_1 = Gpy5
' Gpx5 = Int((rN - GstartN) * Gtimeratio) + G0X
' Gpy5 = Int(G0Y + Glevel3 - (headR4 - headR4_1) * GYratio5)
' '----------------------------------------------------------------------
' If GstartN = rN Then '初回のプロットだけ同じ点
' Gpx1_1 = Gpx1
' Gpy1_1 = Gpy1
' Gpx2_1 = Gpx2
' Gpy2_1 = Gpy2
' Gpx3_1 = Gpx3
' Gpy3_1 = Gpy3
' Gpx4_1 = Gpx4
' Gpy4_1 = Gpy4
' Gpx5_1 = Gpx5
' Gpy5_1 = Gpy5
' End If
' 'Draw string
' g.FillRectangle(Brushes.Black, G0X, G0Y + 18, 900, 20)
' Dim fntg As New Font("MS UI Gothic", 16)
' g.DrawString("Speed=" + speedRF, fntg, Brushes.DeepPink, G0X + 8, G0Y + 15)
' g.DrawString("HeadAngle=" + headRF + "deg", fntg, Brushes.Aquamarine, G0X + 150, G0Y + 15)
' g.DrawString("SkidAngle=" + slipRF + "deg", fntg, Brushes.LawnGreen, G0X + 330, G0Y + 15)
' g.DrawString("SeaHeight=" + elevationF + "m", fntg, Brushes.White, G0X + 500, G0Y + 15)
' g.DrawString("HeadR Dif=" + Format(headR4 - headR4_1, "###.#") + "deg", fntg, Brushes.Red, G0X + 700, G0Y + 15)
' ' slip zero level line
' p.Width = 1
' p.Color = Color.LawnGreen
' 'p.DashStyle = DashStyle.Dash
' 'p.DashPattern = New Single() {1.0F, 2.0F, 3.0F, 4.0F}
' g.DrawLine(p, G0X, G0Y + Glevel3, G0X + Gwidth, G0Y + Glevel3)
' '===========================時系列グラフ値スクロール読み　黄色点===========================
' If Hsc4 = 0 Then
' g.FillEllipse(Brushes.DeepPink, Gpx1, Gpy1, psize, psize)
' g.FillEllipse(Brushes.Aquamarine, Gpx2, Gpy2, psize, psize)
' g.FillEllipse(Brushes.LawnGreen, Gpx3, Gpy3, psize, psize)
' g.FillEllipse(Brushes.White, Gpx4, Gpy4, psize, psize)
' g.FillEllipse(Brushes.Red, Gpx5, Gpy5, psize, psize)
' p.Color = Color.DeepPink
' g.DrawLine(p, Gpx1 + 1, Gpy1 + 1, Gpx1_1 + 1, Gpy1_1 + 1)
' p.Color = Color.Aquamarine
' g.DrawLine(p, Gpx2 + 1, Gpy2 + 1, Gpx2_1 + 1, Gpy2_1 + 1)
' p.Color = Color.LawnGreen
' g.DrawLine(p, Gpx3 + 1, Gpy3 + 1, Gpx3_1 + 1, Gpy3_1 + 1)
' p.Color = Color.White
' g.DrawLine(p, Gpx4 + 1, Gpy4 + 1, Gpx4_1 + 1, Gpy4_1 + 1)
' p.Color = Color.Red
' g.DrawLine(p, Gpx5 + 1, Gpy5 + 1, Gpx5_1 + 1, Gpy5_1 + 1)
' Else
' g.FillEllipse(Brushes.Yellow, Gpx1, Gpy1, marksize, marksize) 'Hscrolbar4のMarker　１０ポイント丸
' g.FillEllipse(Brushes.Yellow, Gpx2, Gpy2, marksize, marksize) 'Hscrolbar4のMarker　１０ポイント丸
' g.FillEllipse(Brushes.Yellow, Gpx3, Gpy3, marksize, marksize) 'Hscrolbar4のMarker　１０ポイント丸
' g.FillEllipse(Brushes.Yellow, Gpx3, Gpy4, marksize, marksize) 'Hscrolbar4のMarker　１０ポイント丸
' 'g.FillEllipse(Brushes.Yellow, Gpx5, Gpy5, marksize, marksize) 'Hscrolbar4のMarker　１０ポイント丸
' 'MarkerをBOLDラインにする
' 'p.Color = Color.DeepPink
' 'p.Width = 5
' 'g.DrawLine(p, Gpx1, Gpy1, Gpx1_1, Gpy1_1)
' 'p.Color = Color.Aquamarine
' 'p.Width = 5
' 'g.DrawLine(p, Gpx2, Gpy2, Gpx2_1, Gpy2_1)
' 'p.Color = Color.LawnGreen
' 'p.Width = 5
' 'g.DrawLine(p, Gpx3, Gpy3, Gpx3_1, Gpy2_1)
' End If
' p.Color = Color.DeepPink
' p.Width = 1
' If Hsc4 = 1 Then '１個前のmarker消す
' g.FillEllipse(Brushes.Black, Gpx1_1, Gpy1_1, marksize, marksize) 'Makerを黒塗りで消す
' g.FillEllipse(Brushes.DeepPink, Gpx1_1, Gpy1_1, psize + 1, psize + 1)
' '-----------------------------------------------
' 'p.Color = Color.Black
' 'p.Width = 5
' 'g.DrawLine(p, Gpx1, Gpy1, Gpx1_1, Gpy1_1) '黒BOLDで消す
' 'p.Color = Color.DeepPink
' 'p.Width = 1
' 'g.DrawLine(p, Gpx1, Gpy1, Gpx1_1, Gpy1_1)
' '---------------------------------------------
' g.FillEllipse(Brushes.Black, Gpx2_1, Gpy2_1, marksize, marksize) 'Makerを黒塗りで消す
' g.FillEllipse(Brushes.Aquamarine, Gpx2_1, Gpy2_1, psize + 1, psize + 1)
' 'p.Color = Color.Black
' 'p.Width = 5
' 'g.DrawLine(p, Gpx2, Gpy2, Gpx2_1, Gpy2_1) '黒BOLDで消す
' 'p.Color = Color.Aquamarine
' 'p.Width = 1
' 'g.DrawLine(p, Gpx2, Gpy2, Gpx2_1, Gpy2_1)
' '-----------------------------------------------------------------------------------
' g.FillEllipse(Brushes.Black, Gpx3_1, Gpy3_1, marksize, marksize) 'Makerを黒塗りで消す
' g.FillEllipse(Brushes.LawnGreen, Gpx3_1, Gpy3_1, psize + 1, psize + 1)
' 'p.Color = Color.Black
' 'p.Width = 5
' 'g.DrawLine(p, Gpx3, Gpy3, Gpx3_1, Gpy3_1) '黒BOLDで消す
' 'p.Color = Color.LawnGreen
' 'p.Width = 1
' 'g.DrawLine(p, Gpx3, Gpy3, Gpx3_1, Gpy3_1)
' g.FillEllipse(Brushes.Black, Gpx4_1, Gpy4_1, marksize, marksize) 'Makerを黒塗りで消す
' g.FillEllipse(Brushes.White, Gpx4_1, Gpy4_1, psize + 1, psize + 1)
' g.FillEllipse(Brushes.Black, Gpx5_1, Gpy5_1, marksize, marksize) 'Makerを黒塗りで消す
' g.FillEllipse(Brushes.Red, Gpx5_1, Gpy5_1, psize + 1, psize + 1)
' End If
'End If
'End If
'///////////////////////////////////////////////////////////////////////////////////////////////
'//////////////////////////////////////////////////////////////////////////////////////////////
'/////////////////////////////////////////////////////////////////////////////////////////////
'====================================================================================================================
''==============================Vector Meter 2案===================================================================================
'If CheckBox11.Checked = True And CheckBox23.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 = 500 '600 change2021/3/9
' 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)
' RarrowX = Int(speedR * Math.Sin(0.0174532 * headR) + Axb1)
' RarrowY = Int(-speedR * 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)
' Dim fnts As New Font("MS UI Gothic", 10, FontStyle.Bold)
' g.DrawString(speedRF + " Skid_" + slipRF + "°", fnts, Brushes.White, 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)
' LarrowX = Int(speedL * Math.Sin(0.0174532 * headL) + Axb2)
' LarrowY = Int(-speedL * 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)
' g.DrawString(speedLF + " Skid_" + slipLF + "°", fnts, Brushes.White, LarrowX, LarrowY)
'End If 'checkbox11
'DGV 行先頭へ表示
'dgv1.FirstDisplayedScrollingRowIndex = rN
'============================================================================================================================
''============================================================================================================================
'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
pxb2_1 = pxb2
pyb2_1 = pyb2
pxr2_1 = pxr2
pyr2_1 = pyr2
If RadioButton6.Checked = True Then
' ************************************平均中心座標***************************************************************
zLon_1 = 0
zLat_1 = 0
pxb2 = (CInt((rNlon - (zLon + zLon_1)) * scale) + xCenter + offX) '+ moffX)
pyb2 = ysize - (CInt((rNlat - (zLat + zLat_1)) * scale) + yCenter + offY) ' - moffY)
pxr2 = (CInt(((rNlon - (zLon + zLon_1) + rNrelE)) * scale) + xCenter + offX) ' + moffX)<<< - to + change 2021/2/24>>>
pyr2 = ysize - (CInt(((rNlat - (zLat + zLat_1) + rNrelN)) * scale) + yCenter + offY) '- moffY)<<< - to + change 2021/2/24>>>
'*****************************************************************************************************************
End If
If RadioButton7.Checked = True Then
'/////////////////////左下　最小値座標//////////////////////////////////////////////////
pxb2 = (CInt((rNlon - Minlon) * scale)) + offX - moffX
pyb2 = ysize - (CInt((rNlat - Minlati) * scale)) + offY - moffY
pxr2 = (CInt(((rNlon - Minlon - rNrelE)) * scale)) + offX - moffX
pyr2 = 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))
If CheckBox12.Checked = True And NutralL(rN) = 1 Then 'Nutral plot Mode
g.FillEllipse(Brushes.Aqua, pxb2, pyb2, 10, 10)
g.FillEllipse(Brushes.Yellow, pxr2, pyr2, 10, 10)
Else
g.FillEllipse(Brushes.Aqua, pxb2, pyb2, 3, 3)
g.FillEllipse(Brushes.Yellow, pxr2, pyr2, 4, 4)
End If
If CheckBox3.Checked = True Then
p.Color = Color.LawnGreen
If delFlag = 1 Then ' delBold() Call
p.Color = Color.Black
End If
p.Width = 3 'Kbold
g.DrawLine(p, pxb2, pyb2, pxr2, pyr2)
End If
'Trace mode
If CheckBox9.Checked = True And pcount > 2 Then
p.Color = Color.Cyan
If delFlag = 1 Then ' delBold() Call
p.Color = Color.Black
End If
p.Width = Kbold
g.DrawLine(p, pxb2, pyb2, pxb2_1, pyb2_1)
p.Color = Color.LawnGreen
g.DrawLine(p, pxr2, pyr2, pxr2_1, pyr2_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
'===========STA モード==================================================
If CheckBox25.Checked = True Then
Dim kitenX As Integer = PictureBox1.Left
Dim kitenY As Integer = PictureBox1.Top
''画面座標でマウスポインタの位置を取得する
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
moffX = (x - kitenX)
moffY = (y - kitenY) '(ysize - (y - kitenY)) '左下
Label42.Text = "X=" + CStr(moffX) + "Y=" + CStr(moffY)
mouseFlag = 1
''Picturebox1内にマウス座標表示
'Dim g3 As Graphics = Graphics.FromImage(PictureBox1.Image)
'Dim fntR As New Font("MS UI Gothic", 16)
'g3.DrawString("MouseX=" + CStr(x) + "MouseY=" + CStr(y), fntR, Brushes.White, 0, 0)
End If
'------------------旧グラフモード-------------------------------------------
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
Return Vrscale
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
Label18.Text = CStr(rScale)
Dim cpd As Double = 1 / rScale
Label39.Text = cpd.ToString("0.000") + "cm/dot"
End Sub
'///////////////////////////////////////////////////////////////////////////////////////////////////////////
'グラフ観察モードでスクロールで描く////////////////////////////////////////////////////////////////////////
'/////////////////////////////////////////////////////////////////////////////////////////////////////////
Private Sub HScrollBar4_ValueChanged(sender As Object, e As EventArgs) Handles HScrollBar4.ValueChanged
minV = Val(TextBox4.Text)
maxV = Val(TextBox5.Text)
HScrollBar4.Maximum = maxV + 9
HScrollBar4.Minimum = minV
'Debug.print("maxv,minV=" + CStr(maxV) + "," + CStr(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
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
'Hscrollbar4を自動スクロール
Private Sub Button15_Click(sender As Object, e As EventArgs) Handles Button15.Click
'maxV minV 間で値をふる
Timer1.Interval = 100
Hsc4 = 1
sw.Start()
Dim ctime As Integer
For i = minV To maxV
HScrollBar4.Value = i
sw.Start()
While sw.ElapsedMilliseconds < 1000
End While
sw.Stop()
sw.Reset()
Next i
End Sub
'picturebox2 マウスクリック移動
Private Sub Form1_MouseClick(sender As Object, e As MouseEventArgs) Handles Me.MouseClick
If CheckBox17.Checked = True Then
Select Case e.Button
Case Windows.Forms.MouseButtons.Left
' MsgBox("左ボタンがクリックされました。")
Dim X As Integer
Dim Y As Integer
X = System.Windows.Forms.Cursor.Position.X - 20
Y = System.Windows.Forms.Cursor.Position.Y - 20
Label34.Text = X & ", " & Y
PictureBox2.Left = X
PictureBox2.Top = Y
End Select
End If
End Sub
'*********************************************************************************************************************************************************************************
'=================================================================================================================================================================================
'時系列GRAPH plotG():Graph Draw処理
'PictureBox1 1800x600 の右下　左上原点 G0(G0X,G0Y)=(800,360) Gwidth=1000,Gheight=240
'=================================================================================================================================================================================
Sub plotG(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 PictureBox3.Image Is Nothing Then '初回だけＢＩＴＭＡＰを定義する　Picture3.imageという名称をつかうこと
' PictureBox3.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))
'グラフプロットパラメータ
'Rspeed
Dim p As New Pen(Color.Blue)
p.Width = 0.1
' 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
Private Sub dgv1_CellContextMenuStripNeeded(sender As Object, e As DataGridViewCellContextMenuStripNeededEventArgs) Handles dgv1.CellContextMenuStripNeeded
If (e.RowIndex < 0) Then Return
If (e.ColumnIndex < 0) Then Return
' クリックされたセルの特定
Dim cell As DataGridViewCell = dgv1(e.ColumnIndex, e.RowIndex)
e.ContextMenuStrip = cMenu1
' セルを選択状態にする
cell.Selected = True
End Sub
Private Sub dgv1_CellMouseClick(sender As Object, e As DataGridViewCellMouseEventArgs) Handles dgv1.CellMouseClick
If e.Button = MouseButtons.Right Then
dgv1.ContextMenuStrip = Me.cMenu1
End If
End Sub
'***********************************flags Check add 2021/4/25 *******************************************************************
Private Sub Button16_Click(sender As Object, e As EventArgs) Handles Button16.Click
Dim iniRow As Integer = dgv1.RowCount
Dim currRow As Integer = iniRow
Dim floatRN As Integer 'flags condition
Dim fixedRN As Integer 'Fixed condition
Dim ferrRN As Integer = 0 'flags error counter
' dgv1.Columns(12).HeaderText = "flags"
' Dim flags As Integer = parPVT(12)
i = 0
While i < currRow - 15
If dgv1.Rows(i).Cells(12).Value = 67 Then ' RTK float Condition
' dgv1.Rows.RemoveAt(i)
currRow = iniRow - 1
floatRN += 1
'RichTextBox1.AppendText("PVT Error:row=" & CStr(i) & "[" & CStr(ferrRN) & "]")
End If
If dgv1.Rows(i).Cells(12).Value = 131 Then ' RTK FIXED Condition
' dgv1.Rows.RemoveAt(i)
currRow = iniRow - 1
fixedRN += 1
'RichTextBox1.AppendText("PVT Error:row=" & CStr(i) & "[" & CStr(ferrRN) & "]")
End If
If dgv1.Rows(i).Cells(12).Value < 67 Then 'NG condition
'dgv1.Rows.RemoveAt(i)
currRow = iniRow - 1
ferrRN += 1
'RichTextBox1.AppendText("flags Error:row=" & CStr(i) & "flags=" & CStr(dgv1.Rows(i).Cells(12).Value) & "[" & CStr(ferrRN) & "]")
End If
i += 1
End While
Dim ferrPercent As Single = (ferrRN / (currRow - 15) * 100)
Dim floatPercent As Single = (floatRN / (currRow - 15) * 100)
Dim fixedPercent As Single = (fixedRN / (currRow - 15) * 100)
RichTextBox1.AppendText("****Total data =" & CStr(currRow - 15) & vbCrLf)
RichTextBox1.AppendText("****Total flags error =" & CStr(ferrRN) & "[" & ferrPercent.ToString("0.00") & "%]" & vbCrLf)
RichTextBox1.AppendText("****flags=67 float =" & CStr(floatRN) & "[" & floatPercent.ToString("0.00") & "%]" & vbCrLf)
RichTextBox1.AppendText("****flags=131 FIXED =" & CStr(fixedRN) & "[" & fixedPercent.ToString("0.00") & "%]" & vbCrLf)
End Sub
'Private Sub dgv1_ContextMenuStripChanged(sender As Object, e As EventArgs) Handles dgv1.ContextMenuStripChanged
' Dim tsmi As ToolStripMenuItem = sender
' Dim indextxt As String = tsmi.Text
' 'Dim source As Control = cMenu1.SourceControl
' 'If source IsNot Nothing Then
' Dim ci As Integer = dgv1.CurrentCell.ColumnIndex
' dgv1.Columns(ci).HeaderText = sender
' 'End If
' ' Dim theItem As ToolStripMenuItem = CType(sender, ToolStripMenuItem)
' 'Dim theItemText As String = theItem.Text
'End Sub
'Private Sub PictureBox1_MouseWheel(sender As Object, e As MouseEventArgs) Handles PictureBox1.MouseWheel
' Me.PictureBox1.Select()
' 'Me.MouseWheel()
' TextBox19.Text = Val(e.Delta)
' If Val(e.Delta) > 0 Then
' End If
'End Sub
'Private Sub Test()
' Dim prj As VCProject
' Dim cfgs, tools As IVCCollection
' Dim cfg As VCConfiguration
' Dim tool As VCLinkerTool
' prj = DTE.Solution.Projects.Item(1).Object
' cfgs = prj.Configurations
' cfg = cfgs.Item(1)
' tool = cfg.Tools("VCLinkerTool")
' tool.LargeAddressAware = addressAwarenessType.addrAwareNoLarge
'End Sub
'===================================================================================================================================================================
'===================================================================================================================================================================
'=====PLOTG Graph plot　Cursor======================================================================================================================================
'===================================================================================================================================================================
Private Sub Button20_Click(sender As Object, e As EventArgs) Handles Button20.Click
PictureBox2.Visible = True
Dim rngf As Integer
Dim grfstartN As Integer = Int(TextBox4.Text)
Dim grfendN As Integer = Int(TextBox5.Text)
'=========================================================================
'============plot point max min average Check============================
'gSpeed col_lon+9
'Dim G1max, G1min, G1ave As Double
'Dim gSpeedCol As Integer = col_lon + 9
'plotStat(gSpeedCol, grfstartN, grfendN, G1max, G1min, G1ave)
'Debug.Print("G1max=" + CStr(G1max) + "," + CStr(G1min) + "," + CStr(G1ave))
''headMot col_lon+10
'Dim G2max, G2min, G2ave As Double
'Dim headMotCol As Integer = col_lon + 10
'plotStat(headMotCol, grfstartN, grfendN, G2max, G2min, G2ave)
'Debug.Print("G2max=" + CStr(G2max) + "," + CStr(G2min) + "," + CStr(G2ave))
''relposHeading col_lon + 24
'Dim G3max, G3min, G3ave As Double
'Dim relheadCol As Integer = col_lon + 24
'plotStat(relheadCol, grfstartN, grfendN, G3max, G3min, G3ave)
'Debug.Print("G3max=" + CStr(G3max) + "," + CStr(G3min) + "," + CStr(G3ave))
'========================================================================
'========================================================================
plotgrf()
End Sub
Sub plotgrf()
'/////////////////////////////////////////////////////////////////////////////////////////////////////////////////
'//////////////////////// STA GRAPH　プロット//////////////////////////////////////////////////////////////////
'///////////////////////////////////////////////////////////////////////////////////////////////////////////////
If grfBitmap Is Nothing Then
grfBitmap = New Bitmap(PictureBox2.Width, PictureBox2.Height) 'PictureBox2
cursorBitmap = New Bitmap(PictureBox2.Width, PictureBox2.Height) 'cursor
End If
Dim g As Graphics = Graphics.FromImage(grfBitmap)
Dim rn As Integer
Dim G0X As Integer = 0 'グラフ左上X座標
Dim G0Y As Integer = 0 'グラフ左上Y座標
Dim Gwidth As Integer = 1200 'グラフ幅
Dim Gheight As Integer = 240 'グラフ高さ
Dim GYratio1, GYratio2, GYratio3, GYratio4, GYratio5 As Double
Dim Galtitude As Double
Dim GstartN As Integer = Int(TextBox4.Text)
Dim GendN As Integer = Int(TextBox5.Text)
Dim GdataSu As Integer = Int(TextBox5.Text) - Int(TextBox4.Text) 'TextBox5-TextBox4 データ数
If GdataSu = 0 Then
GdataSu = 100
End If
Dim Gtimeratio As Double = CDbl(Gwidth / GdataSu) '時間軸比率　横軸　ドット数/データ数
Dim Glevel1, Glevel2, Glevel3, Glevel4, Glevel5 As Integer
Dim psize As Integer = 1
Dim marksize As Integer = 3 '3 plotスライドバー読み
Dim elevationF As String
Dim elevationN As Double
ReDim slopeHeight(GendN)
Dim sumHeight As Double = 0
Dim sumspeed As Double = 0
Dim sumheadmot As Double = 0
Dim sumslipangle As Double = 0
Dim speedave, headmotave, slipangleave As Double
For rn = GstartN To GendN
' Debug.Print("plotgrf 1st getpos rn=" + CStr(rn))
GetPos(rn) 'dgvからデータを読む
'Elevation data------------------------------------------
elevation = dgv1.Rows(rn).Cells(col_lon + 2).Value / 1000
slopeHeight(rn) = elevation
elevationF = Format(elevation, "0000.00")
elevationS = dgv1.Rows(Int(TextBox4.Text)).Cells(col_lon + 2).Value / 1000
elevationE = dgv1.Rows(Int(TextBox5.Text)).Cells(col_lon + 2).Value / 1000
elevationR = elevationS - elevationE '標高差
elevationN = elevation - elevationE '現在の標高差
GYratio4 = (Gheight) / elevationR 'dot/m
Glevel4 = PictureBox2.Height
Gpx4_1 = Gpx4
Gpy4_1 = Gpy4
Gpx4 = Int((rn - GstartN) * Gtimeratio) + G0X
Gpy4 = Int(G0Y + Glevel4 - elevationN * GYratio4)
'Right:Gpx1Gpy1:gSpeed=>speedR kmh プロット 0-60Kmh 60dot----------------------------
GYratio1 = 10
Glevel1 = 300
Gpx1_1 = Gpx1
Gpy1_1 = Gpy1
Gpx1 = Int((rn - GstartN) * Gtimeratio) + G0X
Gpy1 = Int(G0Y + Glevel1 - speedR * GYratio1)
'Left:Gpx12Gpy12:gSpeed=>speedL kmh プロット 0-60Kmh 60dot----------------------------
'GYratio1 = 10
'Glevel1 = 300
'Gpx1_1 = Gpx1
Gpy12_1 = Gpy12
'Gpx1 = Int((rn - GstartN) * Gtimeratio) + G0X
Gpy12 = Int(G0Y + Glevel1 - speedL * GYratio1)
'Right:Gpx2,Gpy2 headMot=>headR deg プロット　0-180deg-------------------------------
GYratio2 = 1
Glevel2 = 200
Gpx2_1 = Gpx2
Gpy2_1 = Gpy2
Gpx2 = Int((rn - GstartN) * Gtimeratio) + G0X
Gpy2 = Int(G0Y + Glevel2 - RNheadmot * GYratio2)
'Left:Gpx2,Gpy2 headMot=>headR deg プロット　0-180deg-------------------------------
'GYratio2 = 1
'Glevel2 = 200
'Gpx2_1 = Gpx2
Gpy22_1 = Gpy22
'Gpx2 = Int((rn - GstartN) * Gtimeratio) + G0X
Gpy22 = Int(G0Y + Glevel2 - LNheadmot * GYratio2)
'Gpx3 Gpy3:Right SlipAngle----------------------------------------------
GYratio3 = 1
Glevel3 = 100
Gpx3_1 = Gpx3
Gpy3_1 = Gpy3
Gpx3 = Int((rn - GstartN) * Gtimeratio) + G0X
Gpy3 = Int(G0Y + Glevel3 - slipAngleR * GYratio3)
'Gpx3 Gpy3:Left SlipAngle----------------------------------------------
'GYratio3 = 1
'Glevel3 = 100
'Gpx3_1 = Gpx3
Gpy32_1 = Gpy32
'Gpx3 = Int((rn - GstartN) * Gtimeratio) + G0X
Gpy32 = Int(G0Y + Glevel3 - slipAngleL * GYratio3)
'Debug.Print("Gpx3=" + CStr(Gpx3) + "slipAngleR=" + CStr(slipAngleR) + "Gpy3=" + CStr(Gpy3))
'----------------------------------------------------------------------
'Differential headR-headR_1 プロット 0-10deg------------------------------------------
GYratio5 = 3
Glevel5 = 100
Gpx5_1 = Gpx5
Gpy5_1 = Gpy5
Gpx5 = Int((rn - GstartN) * Gtimeratio) + G0X
Gpy5 = Int(G0Y + Glevel3 - (headR4 - headR4_1) * GYratio5)
'
'----------------------------------------------------------------------
If GstartN = rn Then '初回のプロットだけ同じ点
Gpx1_1 = Gpx1
Gpy1_1 = Gpy1
Gpx2_1 = Gpx2
Gpy2_1 = Gpy2
Gpx3_1 = Gpx3
Gpy3_1 = Gpy3
Gpx4_1 = Gpx4
Gpy4_1 = Gpy4
Gpx5_1 = Gpx5
Gpy5_1 = Gpy5
Gpx1_1 = Gpx1
Gpy12_1 = Gpy12
Gpx2_1 = Gpx2
Gpy22_1 = Gpy22
Gpx3_1 = Gpx3
Gpy32_1 = Gpy32
Gpx4_1 = Gpx4
Gpy42_1 = Gpy42
Gpx5_1 = Gpx5
Gpy52_1 = Gpy52
End If
Dim p As New Pen(Color.White)
p.Width = 1
'RightSki data
p.Color = Color.DeepPink
g.DrawLine(p, Gpx1 + 1, Gpy1 + 1, Gpx1_1 + 1, Gpy1_1 + 1) 'speedR
p.Color = Color.Red
g.DrawLine(p, Gpx2 + 1, Gpy2 + 1, Gpx2_1 + 1, Gpy2_1 + 1) 'RheadMot
p.Color = Color.Orange
g.DrawLine(p, Gpx3, Gpy3, Gpx3_1, Gpy3_1) 'Rslipangle
p.Color = Color.Gray
g.DrawLine(p, Gpx4 + 1, Gpy4 + 1, Gpx4_1 + 1, Gpy4_1 + 1) 'elevation
'p.Color = Color.Red
'g.DrawLine(p, Gpx5 + 1, Gpy5 + 1, Gpx5_1 + 1, Gpy5_1 + 1)
'Left Ski data
p.Color = Color.RoyalBlue
g.DrawLine(p, Gpx1 + 1, Gpy12 + 1, Gpx1_1 + 1, Gpy12_1 + 1) 'speedR
p.Color = Color.LawnGreen
g.DrawLine(p, Gpx2 + 1, Gpy22 + 1, Gpx2_1 + 1, Gpy22_1 + 1) 'RheadMot
p.Color = Color.Aqua
g.DrawLine(p, Gpx3, Gpy32, Gpx3_1, Gpy32_1) 'Rslipangle
p.Color = Color.Gray
g.DrawLine(p, Gpx4 + 1, Gpy42 + 1, Gpx4_1 + 1, Gpy42_1 + 1) 'elevation
'=================================================================================================================
''========白枠プロット====================================================================
Dim wakusuX As Integer = 12
Dim wakusuY As Integer = 8
Dim wakudotX As Integer = PictureBox2.Width / wakusuX
Dim wakudotY As Integer = PictureBox2.Height / wakusuY
Dim pw As New Pen(Color.Gray, 0.1) 'ラインの色・ラインの太さを設定
For i = 0 To wakusuX 'Y軸=上下軸
g.DrawLine(pw, wakudotX * i, 0, wakudotX * i, PictureBox2.Height)
Next i
For j = 0 To wakusuY 'Ｘ軸=水平軸
g.DrawLine(pw, 0, wakudotY * j, PictureBox2.Width, wakudotY * j)
Next j
PictureBox2.Image = grfBitmap
Next rn
End Sub
'------------------------------Scrollbar3 KEY Pressで移動させる-------------
'PreviewKeyDownイベントハンドラ
Private Sub Button1_PreviewKeyDown(ByVal sender As Object,
ByVal e As PreviewKeyDownEventArgs) _
Handles Button1.PreviewKeyDown
Select Case e.KeyCode
'矢印キーが押されたことを表示する
Case Keys.Up, Keys.Left, Keys.Right, Keys.Down
Console.WriteLine("矢印キーが押されました。")
'Tabキーが押されてもフォーカスが移動しないようにする
Case Keys.Tab
e.IsInputKey = True
End Select
End Sub
'Plotdata statistics
Sub plotStat(ByVal plotcol As Integer, ByVal startrow As Integer, ByVal endrow As Integer, ByRef max As Double, ByRef min As Double, ByRef ave As Double)
Dim i, j As Integer
Dim cellVal As Double = 0
Dim maxVal As Double = 0
Dim minVal As Double = 0
Dim sum As Double = 0
For i = startrow To endrow
cellVal = dgv1.Rows(i).Cells(plotcol).Value
sum = sum + cellVal
If cellVal > maxVal Then
maxVal = cellVal
End If
If cellVal < minVal Then
minVal = cellVal
End If
' Debug.Print("plotcol=" + CStr(plotcol) + "sum=" + CStr(sum) + "maxVal=" + CStr(maxVal) + "minVal=" + CStr(minVal))
Next i
ave = sum / (endrow - startrow + 1)
max = maxVal
min = minVal
End Sub
'ターン構造体番号と行番号ｒNの同期
Private Function turnN(ByVal rn As Integer) As Integer
For i = 0 To tR(0).lastNo - 1
If tR(i).startNo < rn And tR(i).endNo > rn Then
Return i
End If
Next
Return 0
End Function
End Class 'Serial Port Recieve Sample Program
'Form1 Object must create ,button1,2 & textbox 1,2　
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment