901 lines
37 KiB
VB.net
901 lines
37 KiB
VB.net
Imports System.Drawing
|
||
Imports System.Threading
|
||
Imports System.Windows.Forms
|
||
Imports UTS_Core.DebugLog
|
||
Imports UTS_Core.UTSModule.Test
|
||
Imports UTS_Core.UTSModule.Test.Command
|
||
Imports UTS_Core.UTSModule.Test.StatusMonitor
|
||
|
||
Namespace UTSModule.Station
|
||
Public Class FrmStationPlan
|
||
Implements IUtsTest
|
||
Implements IProcessStation
|
||
Implements IProductionLine
|
||
|
||
Private _utsApp As UtsAppForm
|
||
|
||
#Region "初始化"
|
||
Public Property StationPlan() As StationTestPlan
|
||
|
||
Private _planGrid As StationPlanGrid
|
||
|
||
Private _nodeGrid As RowNodeGrid
|
||
|
||
''' <summary>
|
||
''' 显示窗体
|
||
''' </summary>
|
||
''' <param name="parentControl"></param>
|
||
Public Sub ShowForm(parentControl As Control)
|
||
FormBorderStyle = FormBorderStyle.None
|
||
TopLevel = False
|
||
Dock = DockStyle.Fill
|
||
Parent = parentControl
|
||
Enabled = StationPlan IsNot Nothing
|
||
|
||
Show()
|
||
End Sub
|
||
|
||
|
||
''' <summary>
|
||
''' 产线变化
|
||
''' </summary>
|
||
Public Sub ProductionLineChanged() Implements IProductionLine.ProductionLineChanged
|
||
'Todo:产线变化代码
|
||
ApplicationLog.WriteInfoLog($"编辑页面生产线变更中。")
|
||
|
||
|
||
ApplicationLog.WriteInfoLog($"编辑页面生产线变更完成。")
|
||
End Sub
|
||
|
||
|
||
''' <summary>
|
||
''' 测试站修改时处理函数
|
||
''' </summary>
|
||
Public Sub Station_Changed() Implements IProcessStation.StationChanged
|
||
ApplicationLog.WriteInfoLog($"编辑页面站位变更中，PN：{_utsApp.ProcessStation.ParentProject.Name} - SN:{_utsApp.ProcessStation.Name} - TP:{_utsApp.ProcessStation.Packet.Name}!")
|
||
|
||
StationPlan = CType(_utsApp.ProcessStation.Packet.StationPlan, StationTestPlan)
|
||
|
||
Enabled = StationPlan IsNot Nothing
|
||
|
||
If StationPlan IsNot Nothing Then
|
||
_planGrid.HeadNode = StationPlan.HeadNode
|
||
_planGrid.UpdateGrid()
|
||
|
||
StationEditStatusMonitor.StationEditStatus = StationEditStatusMonitor.StationEditStatusEnum.None
|
||
|
||
_tester.ProcessStation = _utsApp.ProcessStation
|
||
End If
|
||
|
||
ApplicationLog.WriteInfoLog($"编辑页面站位变更完成。")
|
||
End Sub
|
||
|
||
|
||
''' <summary>
|
||
''' 初始化行节点的风格
|
||
''' </summary>
|
||
Private Sub InitRowNodeStyles()
|
||
If IO.File.Exists(UtsPath.NodeStylePath()) Then
|
||
RowNode.LoadNodeStyles(UtsPath.NodeStylePath())
|
||
Else
|
||
RowNode.InitNodeStyles()
|
||
End If
|
||
End Sub
|
||
|
||
|
||
Private Sub InitStationPlanGrid()
|
||
_planGrid = New StationPlanGrid With {
|
||
.Grid = GrdStationPlan}
|
||
|
||
End Sub
|
||
|
||
Private Sub InitRowNodeGrid()
|
||
_nodeGrid = New RowNodeGrid With {
|
||
.Grid = GrdRowNode,
|
||
.RtxColTip = RtxColTip}
|
||
|
||
AddHandler _planGrid.PlanNodeSelectChanged, AddressOf PlanGridSelectChanged
|
||
AddHandler _planGrid.PlanGridCommandChanged, AddressOf PlanGridCommandChanged
|
||
'todo:检测撤销队列的变化
|
||
|
||
AddHandler _planGrid.PlanNodeSelectChanged, AddressOf _nodeGrid.Grid_PlanNodeSelectChanged
|
||
AddHandler _planGrid.RowNodeTextChanged, AddressOf _nodeGrid.Grid_RowNodeTextChanged
|
||
|
||
AddHandler _nodeGrid.RowNodeTextChanged, AddressOf _planGrid.Grid_RowNodeTextChanged
|
||
End Sub
|
||
|
||
Private Sub FrmStationPlan_Load(sender As Object, e As EventArgs) Handles Me.Load
|
||
ApplicationLog.WriteInfoLog($"编辑页面加载中。")
|
||
|
||
'初始化UTS窗体信息,失败则关闭窗体
|
||
If InitializeUtsApp() = False Then Return
|
||
|
||
'初始化窗体页面
|
||
InitializeForm()
|
||
|
||
ApplicationLog.WriteInfoLog($"编辑页面加载完成。")
|
||
End Sub
|
||
|
||
Public Sub PlanGridSelectChanged(sender As Object, ByVal e As PlanNodeSelectChangedEventArgs)
|
||
TsBtnBackward.Enabled = _planGrid.CanBackward
|
||
TsBtnForward.Enabled = _planGrid.CanForward
|
||
|
||
'表格移动
|
||
If GrdStationPlan Is Nothing OrElse GrdStationPlan.Tree.SelectedNode Is Nothing Then Return
|
||
Dim canMove As Boolean = True
|
||
Dim startMoveRow As Integer = GrdStationPlan.Selection.FirstRow
|
||
Dim moveRows As Integer = GrdStationPlan.Selection.LastRow - GrdStationPlan.Selection.FirstRow + 1
|
||
Dim startLever As Integer = GrdStationPlan.Tree.FindNode(startMoveRow).Level
|
||
For i As Integer = startMoveRow To startMoveRow + moveRows - 1
|
||
If startLever <> GrdStationPlan.Tree.FindNode(startMoveRow).Level Then
|
||
canMove = False
|
||
Exit For
|
||
End If
|
||
Next
|
||
|
||
TsBtnMoveDown.Enabled = canMove
|
||
TsBtnMoveLeft.Enabled = canMove
|
||
TsBtnMoveRight.Enabled = canMove
|
||
TsBtnMoveUp.Enabled = canMove
|
||
End Sub
|
||
|
||
Public Sub PlanGridCommandChanged(sender As Object, e As EventArgs)
|
||
TsBtnUndo.Enabled = _planGrid.CanUndo
|
||
TsBtnRedo.Enabled = _planGrid.CanRedo
|
||
|
||
MsiUndo.Enabled = _planGrid.CanUndo
|
||
MsiRedo.Enabled = _planGrid.CanRedo
|
||
End Sub
|
||
|
||
|
||
Private Function InitializeUtsApp() As Boolean
|
||
_utsApp = UtsAppForm.CreateSingleton()
|
||
_utsApp.AddStatisticsObserver(Me)
|
||
|
||
Try
|
||
If _utsApp.IsInitialized = False Then
|
||
_utsApp.Initialize() 'Todo:可根据需要限定可选站位
|
||
End If
|
||
Catch ex As Exception
|
||
ApplicationLog.WriteErrorLog($"初始化窗体失败,原因：{ex.Message}!")
|
||
|
||
MsgBox($"初始化窗体失败,原因：{ex.Message}")
|
||
Close()
|
||
Return False
|
||
End Try
|
||
|
||
Return True
|
||
End Function
|
||
|
||
Private Sub InitializeForm()
|
||
InitRowNodeStyles()
|
||
|
||
InitStationPlanGrid()
|
||
|
||
InitRowNodeGrid()
|
||
|
||
InitTester()
|
||
End Sub
|
||
|
||
Private Sub ClearText()
|
||
If RtxOutputInfo.InvokeRequired Then '判断是否需要开委托
|
||
RtxOutputInfo.Invoke(New Action(AddressOf ClearText))
|
||
Return
|
||
End If
|
||
|
||
RtxOutputInfo.Clear()
|
||
End Sub
|
||
|
||
Private Sub AppendText(cor As Color, txt As String)
|
||
If RtxOutputInfo.InvokeRequired Then '判断是否需要开委托
|
||
RtxOutputInfo.Invoke(New Action(Of Color, String)(AddressOf AppendText), New Object() {cor, txt})
|
||
Return
|
||
End If
|
||
|
||
RtxOutputInfo.SelectionColor = cor
|
||
RtxOutputInfo.AppendText($"{Now:[HH:mm:ss:fff}]-{txt}{vbCrLf}")
|
||
RtxOutputInfo.ScrollToCaret()
|
||
End Sub
|
||
|
||
|
||
''' <summary>
|
||
''' 快捷键操作
|
||
''' </summary>
|
||
''' <param name="sender"></param>
|
||
''' <param name="e"></param>
|
||
Private Sub TvwStationPlan_KeyDown(sender As Object, e As KeyEventArgs) Handles Me.KeyDown
|
||
If e.Modifiers = Keys.Control Then
|
||
Select Case e.KeyCode
|
||
Case Keys.O '加载
|
||
LoadTreeViewFormXml()
|
||
Case Keys.S '保存
|
||
ExportTreeViewToXml()
|
||
End Select
|
||
ElseIf e.Modifiers = Keys.Alt Then
|
||
Select Case e.KeyCode
|
||
Case Keys.O '加载指定节点文件
|
||
LoadNodeFile(_planGrid.ActiveNode)
|
||
Case Keys.S '保存指定节点
|
||
SaveNodeFile(_planGrid.ActiveNode)
|
||
End Select
|
||
|
||
ElseIf e.Modifiers = Keys.None Then
|
||
|
||
End If
|
||
End Sub
|
||
#End Region
|
||
|
||
|
||
#Region "增删节点"
|
||
|
||
''' <summary>
|
||
''' 读取XML,加载树状视图
|
||
''' </summary>
|
||
Private Sub LoadTreeViewFormXml()
|
||
Dim revStationPlanPath As String = $"{UtsPath.GetStationPacketTestPlanDirPath(StationPlan.ParentPacket.Name)}\Main.xml"
|
||
|
||
Try
|
||
StationPlan.LoadFile(revStationPlanPath)
|
||
_planGrid.UpdateGrid()
|
||
' _planGrid.GridUpdateEventTrigger(GrdStationPlan) '笨方法，开始就触发一次刷新
|
||
StationEditStatusMonitor.StationEditStatus = StationEditStatusMonitor.StationEditStatusEnum.None
|
||
|
||
If StationEditStatusMonitor.StationEditStatus <> StationEditStatusMonitor.StationEditStatusEnum.Saved Then
|
||
StationEditStatusMonitor.StationEditStatus = StationEditStatusMonitor.StationEditStatusEnum.Saved
|
||
End If
|
||
Catch ex As Exception
|
||
ApplicationLog.WriteErrorLog($"加载测试站流程发生错误,原因：{ex.Message}")
|
||
MsgBox($"加载测试站流程发生错误,原因：{ex.Message}")
|
||
StationPlan.CreateStationPlan()
|
||
End Try
|
||
End Sub
|
||
|
||
''' <summary>
|
||
''' 读取XML,加载树状视图
|
||
''' </summary>
|
||
Private Sub LoadTreeViewFormXml(revStationPlanPath As String)
|
||
Try
|
||
StationPlan.LoadFile(revStationPlanPath)
|
||
_planGrid.UpdateGrid()
|
||
|
||
StationEditStatusMonitor.StationEditStatus = StationEditStatusMonitor.StationEditStatusEnum.None
|
||
|
||
If StationEditStatusMonitor.StationEditStatus <> StationEditStatusMonitor.StationEditStatusEnum.Saved Then
|
||
StationEditStatusMonitor.StationEditStatus = StationEditStatusMonitor.StationEditStatusEnum.Saved
|
||
End If
|
||
Catch ex As Exception
|
||
ApplicationLog.WriteErrorLog($"加载测试站流程发生错误,原因：{ex.Message}")
|
||
MsgBox($"加载测试站流程发生错误,原因：{ex.Message}")
|
||
StationPlan.CreateStationPlan()
|
||
End Try
|
||
End Sub
|
||
|
||
''' <summary>
|
||
''' 将树状视图导出为Xml
|
||
''' </summary>
|
||
Private Sub ExportTreeViewToXml()
|
||
'保存至项目文件
|
||
Dim revStationPlanPath As String = $"{UtsPath.GetStationPacketTestPlanDirPath(StationPlan.ParentPacket.Name)}\Main.xml"
|
||
StationPlan.SaveFile(revStationPlanPath)
|
||
|
||
'备份至临时文件
|
||
Dim tempPath As String = $"{UtsPath.StationDesignDirPath()}\Main.xml"
|
||
StationPlan.SaveFile(tempPath)
|
||
|
||
If StationEditStatusMonitor.StationEditStatus = StationEditStatusMonitor.StationEditStatusEnum.Changed Then
|
||
StationEditStatusMonitor.StationEditStatus = StationEditStatusMonitor.StationEditStatusEnum.Saved
|
||
End If
|
||
End Sub
|
||
|
||
Private Sub TsBtnMoveUp_Click(sender As Object, e As EventArgs) Handles TsBtnMoveUp.Click
|
||
If GrdStationPlan Is Nothing OrElse GrdStationPlan.Tree.SelectedNode Is Nothing Then Return
|
||
|
||
Dim startMoveRow As Integer = GrdStationPlan.Selection.FirstRow
|
||
Dim moveRows As Integer = GrdStationPlan.Selection.LastRow - GrdStationPlan.Selection.FirstRow + 1
|
||
_planGrid.NodeMoveUp(startMoveRow, moveRows)
|
||
End Sub
|
||
|
||
Private Sub TsBtnMoveDown_Click(sender As Object, e As EventArgs) Handles TsBtnMoveDown.Click
|
||
If GrdStationPlan Is Nothing OrElse GrdStationPlan.Tree.SelectedNode Is Nothing Then Return
|
||
|
||
Dim startMoveRow As Integer = GrdStationPlan.Selection.FirstRow
|
||
Dim moveRows As Integer = GrdStationPlan.Selection.LastRow - GrdStationPlan.Selection.FirstRow + 1
|
||
_planGrid.NodeMoveDown(startMoveRow, moveRows)
|
||
End Sub
|
||
|
||
Private Sub TsBtnMoveLeft_Click(sender As Object, e As EventArgs) Handles TsBtnMoveLeft.Click
|
||
If GrdStationPlan Is Nothing OrElse GrdStationPlan.Tree.SelectedNode Is Nothing Then Return
|
||
|
||
Dim startMoveRow As Integer = GrdStationPlan.Selection.FirstRow
|
||
Dim moveRows As Integer = GrdStationPlan.Selection.LastRow - GrdStationPlan.Selection.FirstRow + 1
|
||
_planGrid.NodeMoveLeft(startMoveRow, moveRows)
|
||
End Sub
|
||
|
||
Private Sub TsBtnMoveRight_Click(sender As Object, e As EventArgs) Handles TsBtnMoveRight.Click
|
||
If GrdStationPlan Is Nothing OrElse GrdStationPlan.Tree.SelectedNode Is Nothing Then Return
|
||
|
||
Dim startMoveRow As Integer = GrdStationPlan.Selection.FirstRow
|
||
Dim moveRows As Integer = GrdStationPlan.Selection.LastRow - GrdStationPlan.Selection.FirstRow + 1
|
||
_planGrid.NodeMoveRight(startMoveRow, moveRows)
|
||
End Sub
|
||
|
||
Private Sub TsBtnOpen_Click(sender As Object, e As EventArgs) Handles TsBtnOpen.Click
|
||
Using xml As New OpenFileDialog
|
||
xml.Filter = $"流程文件(*.xml)|*.xml"
|
||
|
||
If xml.ShowDialog() = DialogResult.OK Then
|
||
ApplicationLog.WriteInfoLog($"编辑页面执行流程正在加载{xml.FileName}")
|
||
LoadTreeViewFormXml(xml.FileName)
|
||
ApplicationLog.WriteInfoLog($"编辑页面执行流程加载完成。")
|
||
End If
|
||
End Using
|
||
|
||
_planGrid.ClearNavigation()
|
||
_planGrid.ClearCommand()
|
||
|
||
PlanGridSelectChanged(Nothing, Nothing)
|
||
PlanGridCommandChanged(Nothing, Nothing)
|
||
End Sub
|
||
|
||
Private Sub TsBtnLoad_Click(sender As Object, e As EventArgs) Handles TsBtnLoad.Click
|
||
If MsgBox("重载会将流程返回为上一次保存的流程状态,是否继续", MsgBoxStyle.OkCancel) = MsgBoxResult.Ok Then
|
||
ApplicationLog.WriteInfoLog($"编辑页面执行流程重载中。")
|
||
LoadTreeViewFormXml()
|
||
_planGrid.ClearNavigation()
|
||
_planGrid.ClearCommand()
|
||
PlanGridSelectChanged(Nothing, Nothing)
|
||
PlanGridCommandChanged(Nothing, Nothing)
|
||
|
||
ApplicationLog.WriteInfoLog($"编辑页面执行流程重载完成。")
|
||
End If
|
||
End Sub
|
||
|
||
|
||
Private Sub TsBtnSave_Click(sender As Object, e As EventArgs) Handles TsBtnSave.Click
|
||
'记录名称重名检测
|
||
If _planGrid.CheckRecordDuplicateName() = False Then Return
|
||
|
||
ApplicationLog.WriteInfoLog($"编辑页面执行流程保存中。")
|
||
ExportTreeViewToXml()
|
||
ApplicationLog.WriteInfoLog($"编辑页面执行流程保存完成。")
|
||
End Sub
|
||
#End Region
|
||
|
||
#Region "保存与读取节点文件"
|
||
|
||
Private Sub SaveNodeFile(node As RowNode)
|
||
If node Is Nothing Then Return
|
||
|
||
Using dialog As New SaveFileDialog
|
||
dialog.Title = $"请输入需要保存节点的文件名"
|
||
dialog.AddExtension = True
|
||
dialog.Filter = $"节点文件(*.xml)|*.xml"
|
||
If dialog.ShowDialog() <> DialogResult.OK Then Return
|
||
|
||
node.ExportToXml(dialog.FileName)
|
||
End Using
|
||
End Sub
|
||
|
||
Private Sub LoadNodeFile(node As RowNode)
|
||
If node Is Nothing Then Return
|
||
|
||
Using dialog As New OpenFileDialog
|
||
dialog.Title = $"请选择需要加载的节点文件"
|
||
dialog.Filter = $"节点文件(*.xml)|*.xml"
|
||
dialog.Multiselect = False
|
||
If dialog.ShowDialog() <> DialogResult.OK Then Return
|
||
|
||
Dim childRowNode As New RowNode
|
||
childRowNode.LoadFormXml(dialog.FileName)
|
||
|
||
_planGrid.NodesAdd(childRowNode)
|
||
|
||
If node.Expanded = False Then node.Expand() '展开当前节点
|
||
End Using
|
||
|
||
End Sub
|
||
|
||
Private Sub MsiSaveNodeFile_Click(sender As Object, e As EventArgs) Handles MsiSaveNodeFile.Click
|
||
SaveNodeFile(_planGrid.ActiveNode)
|
||
End Sub
|
||
|
||
|
||
Private Sub MsiLoadNodeFile_Click(sender As Object, e As EventArgs) Handles MsiLoadNodeFile.Click
|
||
LoadNodeFile(_planGrid.ActiveNode)
|
||
End Sub
|
||
#End Region
|
||
|
||
#Region "调试反馈"
|
||
Private Sub TestStart(sender As Object, e As EventArgs) Implements IUtsTest.TestStart
|
||
If _tester.DebugMode = False Then Return
|
||
ClearText()
|
||
AppendText(Color.Blue, $"TestStart!{vbCrLf}")
|
||
End Sub
|
||
|
||
Private Sub TestPass(sender As Object, e As EventArgs) Implements IUtsTest.TestPass
|
||
If _tester.DebugMode = False Then Return
|
||
AppendText(Color.Blue, $"TestPass!{vbCrLf}")
|
||
End Sub
|
||
|
||
Private Sub TestFail(sender As Object, e As TestFailEventArgs) Implements IUtsTest.TestFail
|
||
If _tester.DebugMode = False Then Return
|
||
AppendText(Color.Blue, $"TestFail!{vbCrLf}")
|
||
End Sub
|
||
|
||
Private Sub TestPause(sender As Object, e As TestPauseEventArgs) Implements IUtsTest.TestPause
|
||
If _tester.DebugMode = False Then Return
|
||
AppendText(Color.Blue, $"TestPause!{vbCrLf}")
|
||
End Sub
|
||
|
||
Private Sub TestEnd(sender As Object, e As TestEndEventArgs) Implements IUtsTest.TestEnd
|
||
If _tester.DebugMode = False Then Return
|
||
AppendText(Color.Blue, $"TestEnd!{vbCrLf}")
|
||
End Sub
|
||
|
||
Private Sub TestNodeChanged(sender As Object, e As TestNodeChangedEventArgs) Implements IUtsTest.TestNodeChanged
|
||
If _tester.DebugMode = False Then Return
|
||
If GrdStationPlan.InvokeRequired Then '判断是否需要开委托
|
||
GrdStationPlan.Invoke(New Action(Of Object, TestNodeChangedEventArgs)(AddressOf TestNodeChanged), New Object() {sender, e})
|
||
Return
|
||
End If
|
||
|
||
AppendText(Color.Black, $"Row:{e.Node.RowListIndex};Desc:{e.Node.Description}")
|
||
|
||
_planGrid.TestNodeChanged(e.Node)
|
||
End Sub
|
||
|
||
|
||
Private Sub TestNodeResultChanged(sender As Object, e As TestNodeResultChangedEventArgs) Implements IUtsTest.TestNodeResultChanged
|
||
If _tester.DebugMode = False Then Return
|
||
If GrdStationPlan.InvokeRequired Then '判断是否需要开委托
|
||
GrdStationPlan.Invoke(New Action(Of Object, TestNodeResultChangedEventArgs)(AddressOf TestNodeResultChanged), New Object() {sender, e})
|
||
Return
|
||
End If
|
||
|
||
Dim cor As Color
|
||
If e.TestReturn.ExecuteResult Then
|
||
cor = Color.Green
|
||
Else
|
||
cor = Color.Red
|
||
End If
|
||
'Dim txt As String = $"Result:{e.TestReturn.ExecuteResult};Retrun:{e.TestReturn.RecordValue};Lower:{e.TestReturn.LowerLimit};Upper:{e.TestReturn.UpperLimit};Tip:{e.TestReturn.ExecuteResultTipString}{vbCrLf}"
|
||
'Momo 2023-12-15 提示信息增加两个标准显示
|
||
Dim txt As String = $"Result:{e.TestReturn.ExecuteResult}; Retrun:{e.TestReturn.RecordValue}; Lower_1:{e.TestReturn.LowerLimit};Upper_1:{e.TestReturn.UpperLimit}; Lower_2:{e.TestReturn.LowerLimit_2};Upper_2:{e.TestReturn.UpperLimit_2}; Tip:{e.TestReturn.ExecuteResultTipString}{vbCrLf}"
|
||
|
||
AppendText(cor, txt)
|
||
|
||
_planGrid.NodeCompleted(e.Node, e.TestReturn)
|
||
End Sub
|
||
|
||
Private Sub TestNodeCompleted(sender As Object, e As TestNodeCompletedEventArgs) Implements IUtsTest.TestNodeCompleted
|
||
If _tester.DebugMode = False Then Return
|
||
If GrdStationPlan.InvokeRequired Then '判断是否需要开委托
|
||
GrdStationPlan.Invoke(New Action(Of Object, TestNodeCompletedEventArgs)(AddressOf TestNodeCompleted), New Object() {sender, e})
|
||
Return
|
||
End If
|
||
|
||
Dim cor As Color
|
||
If e.TestReturn.ExecuteResult Then
|
||
cor = Color.Green
|
||
Else
|
||
cor = Color.Red
|
||
End If
|
||
'Dim txt As String = $"Result:{e.TestReturn.ExecuteResult};Retrun:{e.TestReturn.RecordValue};Lower:{e.TestReturn.LowerLimit};Upper:{e.TestReturn.UpperLimit};Tip:{e.TestReturn.ExecuteResultTipString}{vbCrLf}"
|
||
'Momo 2023-12-15 提示信息增加两个标准显示
|
||
Dim txt As String = $"Result:{e.TestReturn.ExecuteResult}; Retrun:{e.TestReturn.RecordValue}; Lower_1:{e.TestReturn.LowerLimit};Upper_1:{e.TestReturn.UpperLimit}; Lower_2:{e.TestReturn.LowerLimit_2};Upper_2:{e.TestReturn.UpperLimit_2}; Tip:{e.TestReturn.ExecuteResultTipString}{vbCrLf}"
|
||
|
||
AppendText(cor, txt)
|
||
|
||
_planGrid.NodeCompleted(e.Node, e.TestReturn)
|
||
End Sub
|
||
|
||
Private Sub TestStatusChanged(sender As Object, e As TestStatusChangedEventArgs) Implements IUtsTest.TestStatusChanged
|
||
If _tester.DebugMode = False Then Return
|
||
If StuMain.InvokeRequired Then '判断是否需要开委托
|
||
StuMain.Invoke(New Action(Of Object, TestStatusChangedEventArgs)(AddressOf TestStatusChanged), New Object() {sender, e})
|
||
Return
|
||
End If
|
||
|
||
Select Case e.Status
|
||
Case TestStatusMonitor.TestStatusEnum.WaitForTest
|
||
TssLblTestStatus.ForeColor = Color.Gray
|
||
TssLblTestStatus.Text = $"未测试"
|
||
Case TestStatusMonitor.TestStatusEnum.Testing
|
||
TssLblTestStatus.ForeColor = Color.Blue
|
||
TssLblTestStatus.Text = $"测试中"
|
||
Case TestStatusMonitor.TestStatusEnum.TestPass
|
||
TssLblTestStatus.ForeColor = Color.Green
|
||
TssLblTestStatus.Text = $"测试成功"
|
||
Case TestStatusMonitor.TestStatusEnum.TestFail
|
||
TssLblTestStatus.ForeColor = Color.Red
|
||
TssLblTestStatus.Text = $"测试失败"
|
||
Case TestStatusMonitor.TestStatusEnum.DeviceError
|
||
TssLblTestStatus.ForeColor = Color.DarkRed
|
||
TssLblTestStatus.Text = $"设备错误"
|
||
Case Else
|
||
Console.WriteLine($"UpdateTestStatus Unknown:{e.Status}")
|
||
End Select
|
||
End Sub
|
||
|
||
Private Sub TestTimeChanged(sender As Object, e As TestTimeEventArgs) Implements IUtsTest.TestTimeChanged
|
||
If _tester.DebugMode = False Then Return
|
||
If StuMain.InvokeRequired Then '判断是否需要开委托
|
||
StuMain.Invoke(New Action(Of Object, TestTimeEventArgs)(AddressOf TestTimeChanged), New Object() {sender, e})
|
||
Return
|
||
End If
|
||
|
||
TssLblTestTime.Text = $"TimeExpend:{e.TimeElapsed.Hours:D2}:{e.TimeElapsed.Minutes:D2}:{e.TimeElapsed.Seconds:D2}:{e.TimeElapsed.Milliseconds:D3}"
|
||
End Sub
|
||
|
||
Private Sub TestProgressChanged(sender As Object, e As TestProgressChangedEventArgs) Implements IUtsTest.TestProgressChanged
|
||
If _tester.DebugMode = False Then Return
|
||
If StuMain.InvokeRequired Then '判断是否需要开委托
|
||
StuMain.Invoke(New Action(Of Object, TestProgressChangedEventArgs)(AddressOf TestProgressChanged), New Object() {sender, e})
|
||
Return
|
||
End If
|
||
|
||
If e.Percent < TssBarTestProgress.Minimum Then e.Percent = TssBarTestProgress.Minimum
|
||
If e.Percent > TssBarTestProgress.Maximum Then e.Percent = TssBarTestProgress.Maximum
|
||
TssBarTestProgress.Value = CType(e.Percent, Integer)
|
||
End Sub
|
||
|
||
Private Sub RetryProgressChanged(sender As Object, e As TestProgressChangedEventArgs) Implements IUtsTest.RetryProgressChanged
|
||
If _tester.DebugMode = False Then Return
|
||
AppendText(Color.Blue, $"重试剩余：{e.Percent:F2}%")
|
||
End Sub
|
||
|
||
Public Sub TestCountChanged(sender As Object, e As TestCountChangedEventArgs) Implements IUtsTest.TestCountChanged
|
||
If _tester.DebugMode = False Then Return
|
||
AppendText(Color.Blue, $"当前测试总数：{e.Count},成功数：{e.PassCount},失败数：{e.FailCount}")
|
||
End Sub
|
||
|
||
#End Region
|
||
|
||
#Region "调试模式"
|
||
Private _tester As UtsTester
|
||
|
||
Private Sub InitTester()
|
||
_tester = UtsTester.CreateTester()
|
||
|
||
AddHandler _tester.TestStart, AddressOf TestStart
|
||
AddHandler _tester.TestPass, AddressOf TestPass
|
||
AddHandler _tester.TestFail, AddressOf TestFail
|
||
AddHandler _tester.TestPause, AddressOf TestPause
|
||
AddHandler _tester.TestEnd, AddressOf TestEnd
|
||
|
||
AddHandler _tester.TestStatusChanged, AddressOf TestStatusChanged
|
||
|
||
AddHandler _tester.TestNodeChanged, AddressOf TestNodeChanged
|
||
AddHandler _tester.TestNodeCompleted, AddressOf TestNodeCompleted
|
||
AddHandler _tester.TestNodeResultChanged, AddressOf TestNodeResultChanged
|
||
|
||
AddHandler _tester.TestProgressChanged, AddressOf TestProgressChanged
|
||
AddHandler _tester.RetryProgressChanged, AddressOf RetryProgressChanged
|
||
|
||
AddHandler _tester.TestTimeChanged, AddressOf TestTimeChanged
|
||
|
||
AddHandler StationEditStatusMonitor.StationEditStatusChanged, AddressOf _tester.StationEditStatusChanged
|
||
|
||
End Sub
|
||
|
||
''' <summary>
|
||
''' 调试模式
|
||
''' </summary>
|
||
Private Sub TsBtnDebugMode_Click(sender As Object, e As EventArgs) Handles TsBtnDebugMode.Click
|
||
Static editMode As Boolean = False
|
||
editMode = Not editMode
|
||
|
||
_planGrid.DebugMode = editMode
|
||
TsBtnDebugMode.Text = $"{IIf(editMode, $"编辑模式", $"调试模式")}"
|
||
End Sub
|
||
|
||
Private _debugTest As Thread
|
||
|
||
|
||
Private Sub TsBtnDebug_Click(sender As Object, e As EventArgs) Handles TsBtnDebugStart.Click
|
||
If _debugTest IsNot Nothing AndAlso _debugTest.IsAlive Then
|
||
MsgBox($"请先退出当前调试后重试")
|
||
Return
|
||
End If
|
||
|
||
_planGrid.ClearDebug()
|
||
_debugTest = New Thread(AddressOf _tester.StartDebugTest) With {
|
||
.IsBackground = True
|
||
}
|
||
_debugTest.Start()
|
||
End Sub
|
||
|
||
Private Sub TsBtnFailMode_Click(sender As Object, e As EventArgs) Handles TsBtnFailMode.Click
|
||
Static flg As Boolean = False
|
||
flg = Not flg
|
||
|
||
If flg Then
|
||
_tester.TestFailMode = UtsTester.TestFailModeEnum.AllFail
|
||
TsBtnFailMode.Text = $"全部退出"
|
||
Else
|
||
_tester.TestFailMode = UtsTester.TestFailModeEnum.StepFail
|
||
TsBtnFailMode.Text = $"单步退出"
|
||
End If
|
||
|
||
End Sub
|
||
|
||
Private Sub TsmiDebugStart_Click(sender As Object, e As EventArgs) Handles TsmiDebugStart.Click
|
||
If _debugTest IsNot Nothing AndAlso _debugTest.IsAlive Then
|
||
MsgBox($"请先退出当前调试后重试")
|
||
Return
|
||
End If
|
||
|
||
_planGrid.ClearDebug()
|
||
_debugTest = New Thread(AddressOf _tester.StartDebugTest) With {
|
||
.IsBackground = True
|
||
}
|
||
_debugTest.Start()
|
||
End Sub
|
||
|
||
Private Sub 执行1ToolStripMenuItem_Click(sender As Object, e As EventArgs) Handles 执行1ToolStripMenuItem.Click
|
||
If _debugTest IsNot Nothing AndAlso _debugTest.IsAlive Then
|
||
MsgBox($"请先退出当前调试后重试")
|
||
Return
|
||
End If
|
||
|
||
'_planGrid.ClearDebug()
|
||
StartDebugThread(AddressOf _tester.TestNode, _planGrid.ActiveNode)
|
||
End Sub
|
||
|
||
Private Async Sub 执行2ToolStripMenuItem_Click(sender As Object, e As EventArgs) Handles 执行2ToolStripMenuItem.Click
|
||
'If _debugTest IsNot Nothing AndAlso _debugTest.IsAlive Then
|
||
' MsgBox($"请先退出当前调试后重试")
|
||
' Return
|
||
'End If
|
||
|
||
'_planGrid.ClearDebug()
|
||
'StartDebugThread(AddressOf _tester.TestNode, _planGrid.ActiveNode)
|
||
|
||
' _planGrid.ClearDebug()
|
||
|
||
Dim row As Integer = _planGrid.ActiveNode.RowListIndex
|
||
Dim result As TestCommandReturn = Await Task.Run(Function()
|
||
Return _tester.TestNode(_planGrid.ActiveNode)
|
||
End Function, _testerCancel)
|
||
|
||
If result IsNot Nothing AndAlso result.ExecuteResult Then _planGrid.SetRowFocus(row + 1)
|
||
End Sub
|
||
|
||
Private Sub TsmiStepDebug_Click(sender As Object, e As EventArgs) Handles TsmiDebugStep.Click
|
||
_tester.StepTest()
|
||
End Sub
|
||
|
||
Private Sub TsmiContinueDebug_Click(sender As Object, e As EventArgs) Handles TsmiDebugContinue.Click
|
||
_tester.ContinueTest()
|
||
End Sub
|
||
|
||
Private Sub TsmiDebugEnd_Click(sender As Object, e As EventArgs) Handles TsmiDebugEnd.Click
|
||
_tester.ExitTest()
|
||
End Sub
|
||
|
||
Private Sub TsmiDebugSetup_Click(sender As Object, e As EventArgs) Handles TsmiDebugSetup.Click
|
||
If _debugTest IsNot Nothing AndAlso _debugTest.IsAlive Then
|
||
MsgBox($"请先退出当前调试后重试")
|
||
Return
|
||
End If
|
||
|
||
|
||
_planGrid.ClearDebug()
|
||
_debugTest = New Thread(AddressOf _tester.TestSetupModule) With {
|
||
.IsBackground = True
|
||
}
|
||
_debugTest.Start()
|
||
End Sub
|
||
|
||
Private Sub TsmiDebugMain_Click(sender As Object, e As EventArgs) Handles TsmiDebugMain.Click
|
||
If _debugTest IsNot Nothing AndAlso _debugTest.IsAlive Then
|
||
MsgBox($"请先退出当前调试后重试")
|
||
Return
|
||
End If
|
||
|
||
_planGrid.ClearDebug()
|
||
_debugTest = New Thread(AddressOf _tester.TestMainModule) With {
|
||
.IsBackground = True
|
||
}
|
||
_debugTest.Start()
|
||
End Sub
|
||
|
||
Private Sub TsmiDebugPass_Click(sender As Object, e As EventArgs) Handles TsmiDebugPass.Click
|
||
If _debugTest IsNot Nothing AndAlso _debugTest.IsAlive Then
|
||
MsgBox($"请先退出当前调试后重试")
|
||
Return
|
||
End If
|
||
|
||
_planGrid.ClearDebug()
|
||
_debugTest = New Thread(AddressOf _tester.TestPassModule) With {
|
||
.IsBackground = True
|
||
}
|
||
_debugTest.Start()
|
||
End Sub
|
||
|
||
Private Sub TsmiDebugFail_Click(sender As Object, e As EventArgs) Handles TsmiDebugFail.Click
|
||
If _debugTest IsNot Nothing AndAlso _debugTest.IsAlive Then
|
||
MsgBox($"请先退出当前调试后重试")
|
||
Return
|
||
End If
|
||
|
||
_planGrid.ClearDebug()
|
||
_debugTest = New Thread(AddressOf _tester.TestFailModule) With {
|
||
.IsBackground = True
|
||
}
|
||
_debugTest.Start()
|
||
End Sub
|
||
|
||
Private Sub TsmiDebugCleanup_Click(sender As Object, e As EventArgs) Handles TsmiDebugCleanup.Click
|
||
If _debugTest IsNot Nothing AndAlso _debugTest.IsAlive Then
|
||
MsgBox($"请先退出当前调试后重试")
|
||
Return
|
||
End If
|
||
|
||
_planGrid.ClearDebug()
|
||
_debugTest = New Thread(AddressOf _tester.TestCleanupModule) With {
|
||
.IsBackground = True
|
||
}
|
||
_debugTest.Start()
|
||
End Sub
|
||
|
||
Private _testerCancel As New CancellationToken
|
||
|
||
Private Sub TsmiDebugNode_Click(sender As Object, e As EventArgs) Handles TsmiDebugNode.Click
|
||
'If _debugTest IsNot Nothing AndAlso _debugTest.IsAlive Then
|
||
' MsgBox($"请先退出当前调试后重试")
|
||
' Return
|
||
'End If
|
||
|
||
_planGrid.ClearDebug()
|
||
|
||
'Dim row As Integer = _planGrid.ActiveNode.RowListIndex
|
||
'Dim result As TestCommandReturn = Await Task.Run(Function()
|
||
' Return _tester.TestNode(_planGrid.ActiveNode)
|
||
' End Function, _testerCancel)
|
||
|
||
'If result IsNot Nothing AndAlso result.ExecuteResult Then _planGrid.SetFocus(row + 1, StationPlanGrid.ColNames.Description)
|
||
|
||
|
||
StartDebugThread(AddressOf _tester.TestNode, _planGrid.ActiveNode)
|
||
End Sub
|
||
|
||
|
||
Private Sub TsmiDebugNodeBegin_Click(sender As Object, e As EventArgs) Handles TsmiDebugNodeBegin.Click
|
||
If _debugTest IsNot Nothing AndAlso _debugTest.IsAlive Then
|
||
MsgBox($"请先退出当前调试后重试")
|
||
Return
|
||
End If
|
||
|
||
_planGrid.ClearDebug()
|
||
|
||
StartDebugThread(AddressOf _tester.TestBeginWithNode, _planGrid.ActiveNode)
|
||
End Sub
|
||
|
||
Private Sub StartDebugThread(start As ParameterizedThreadStart)
|
||
_debugTest = New Thread(start) With {
|
||
.IsBackground = True
|
||
}
|
||
_debugTest.Start()
|
||
End Sub
|
||
|
||
Private Sub StartDebugThread(start As ParameterizedThreadStart, parameter As Object)
|
||
_debugTest = New Thread(start) With {
|
||
.IsBackground = True
|
||
}
|
||
_debugTest.Start(parameter)
|
||
End Sub
|
||
|
||
Private Sub TsBtnSaveAs_Click(sender As Object, e As EventArgs) Handles TsBtnSaveAs.Click
|
||
Using dlg As New SaveFileDialog
|
||
dlg.Filter = "Excel 文件(*.xls)|*.xls|CSV 文件(*.csv)|*.csv|PDF 文件(*.pdf)|*.pdf|Flexcell 文件(*.flx)|*.flx"
|
||
dlg.AddExtension = True
|
||
If dlg.ShowDialog <> DialogResult.OK Then Return
|
||
Cursor = Cursors.WaitCursor
|
||
|
||
ApplicationLog.WriteInfoLog($"编辑页面执行流程导出中。")
|
||
Try
|
||
Select Case dlg.FilterIndex
|
||
Case 1
|
||
GrdStationPlan.ExportToExcel(dlg.FileName, True, True)
|
||
Case 2
|
||
GrdStationPlan.ExportToCSV(dlg.FileName, True, True)
|
||
Case 3
|
||
GrdStationPlan.ExportToPDF(dlg.FileName)
|
||
Case 4
|
||
GrdStationPlan.SaveFile(dlg.FileName)
|
||
End Select
|
||
|
||
ApplicationLog.WriteInfoLog($"编辑页面执行流程导出完成。")
|
||
Catch ex As Exception
|
||
ApplicationLog.WriteErrorLog($"编辑页面执行流程导出失败,原因：{ex.Message}")
|
||
MsgBox($"编辑页面执行流程导出失败,原因：{ex.Message}")
|
||
End Try
|
||
Cursor = Cursors.Arrow
|
||
End Using
|
||
End Sub
|
||
|
||
Private Sub tslBtn_ActionOnly_Click(sender As Object, e As EventArgs) Handles tslBtn_ActionOnly.Click
|
||
Static OnlyShowAction As Boolean = False
|
||
OnlyShowAction = Not OnlyShowAction
|
||
_planGrid.SetNodeActionShowMode(OnlyShowAction)
|
||
End Sub
|
||
|
||
Private Sub TsBtn_Record_Click(sender As Object, e As EventArgs) Handles TsBtn_Record.Click
|
||
Static OnlyShowRecord As Boolean = False
|
||
OnlyShowRecord = Not OnlyShowRecord
|
||
_planGrid.SetNodeRecordShowMode(OnlyShowRecord)
|
||
End Sub
|
||
|
||
Private Sub TsBtn_ExpandNode_Click(sender As Object, e As EventArgs) Handles TsBtn_ExpandNode.Click
|
||
Static NodeExpand As Boolean = True
|
||
NodeExpand = Not NodeExpand
|
||
_planGrid.SetNodeExpand(NodeExpand)
|
||
End Sub
|
||
|
||
Private Sub tsBtnInsertRow_Click(sender As Object, e As EventArgs) Handles tsBtnInsertRow.Click
|
||
Dim tmpFrisRow As Integer = GrdStationPlan.Selection.FirstRow
|
||
Dim tmpLastRow As Integer = GrdStationPlan.Selection.LastRow
|
||
Dim tempRowCount As Integer = tmpLastRow - tmpFrisRow + 1
|
||
_planGrid.NodeAdd(tmpFrisRow, tempRowCount)
|
||
End Sub
|
||
|
||
Private Sub tsBtnRemoveRow_Click(sender As Object, e As EventArgs) Handles tsBtnRemoveRow.Click
|
||
Dim tmpFrisRow As Integer = GrdStationPlan.Selection.FirstRow
|
||
Dim tmpLastRow As Integer = GrdStationPlan.Selection.LastRow
|
||
Dim tempRowCount As Integer = tmpLastRow - tmpFrisRow + 1
|
||
_planGrid.NodeDel(tmpFrisRow, tempRowCount)
|
||
End Sub
|
||
|
||
Private Sub MsiGridRowBlockInsert_Click(sender As Object, e As EventArgs) Handles MsiGridRowBlockInsert.Click
|
||
tsBtnInsertRow.PerformClick()
|
||
End Sub
|
||
|
||
Private Sub MsiGridRowBlockDelete_Click(sender As Object, e As EventArgs) Handles MsiGridRowBlockDelete.Click
|
||
tsBtnRemoveRow.PerformClick()
|
||
End Sub
|
||
|
||
Private Sub TsBtnCopyWholeRow_Click(sender As Object, e As EventArgs) Handles TsBtnBackward.Click
|
||
_planGrid.BackwardNavigation()
|
||
End Sub
|
||
|
||
Private Sub TsBtnPasteWholdRows_Click(sender As Object, e As EventArgs) Handles TsBtnForward.Click
|
||
_planGrid.ForwardNavigation()
|
||
End Sub
|
||
|
||
Private Sub tsBtn_CheckAction_Click(sender As Object, e As EventArgs) Handles tsBtn_CheckAction.Click
|
||
Dim tmpFrisRow As Integer = GrdStationPlan.Selection.FirstRow
|
||
Dim tmpLastRow As Integer = GrdStationPlan.Selection.LastRow
|
||
|
||
_planGrid.Check_Uncheck_Action(GrdStationPlan, tmpFrisRow, tmpLastRow, True)
|
||
End Sub
|
||
|
||
Private Sub tsBtn_UncheckAction_Click(sender As Object, e As EventArgs) Handles tsBtn_UncheckAction.Click
|
||
Dim tmpFrisRow As Integer = GrdStationPlan.Selection.FirstRow
|
||
Dim tmpLastRow As Integer = GrdStationPlan.Selection.LastRow
|
||
|
||
_planGrid.Check_Uncheck_Action(GrdStationPlan, tmpFrisRow, tmpLastRow, False)
|
||
End Sub
|
||
|
||
Private Sub MsiUndo_Click(sender As Object, e As EventArgs) Handles MsiUndo.Click, TsBtnUndo.Click
|
||
_planGrid.UndoCommand()
|
||
End Sub
|
||
|
||
Private Sub MsiRedo_Click(sender As Object, e As EventArgs) Handles MsiRedo.Click, TsBtnRedo.Click
|
||
_planGrid.RedoCommand()
|
||
End Sub
|
||
|
||
Private Sub TsmiJumpCall_Click(sender As Object, e As EventArgs) Handles TsmiJumpCall.Click
|
||
_planGrid.JumpCall()
|
||
End Sub
|
||
|
||
|
||
|
||
#End Region
|
||
|
||
|
||
|
||
|
||
|
||
End Class
|
||
End Namespace |