Imports System.Drawing Imports System.Threading Imports System.Windows.Forms Imports UTS_Core.DebugLog Imports UTS_Core.UTSModule.Test 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 ''' ''' 显示窗体 ''' ''' Public Sub ShowForm(parentControl As Control) FormBorderStyle = FormBorderStyle.None TopLevel = False Dock = DockStyle.Fill Parent = parentControl Enabled = StationPlan IsNot Nothing Show() End Sub ''' ''' 产线变化 ''' Public Sub ProductionLineChanged() Implements IProductionLine.ProductionLineChanged 'Todo:产线变化代码 ApplicationLog.WriteInfoLog($"编辑页面生产线变更中。") ApplicationLog.WriteInfoLog($"编辑页面生产线变更完成。") End Sub ''' ''' 测试站修改时处理函数 ''' 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 ''' ''' 初始化行节点的风格 ''' 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 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 ''' ''' 快捷键操作 ''' ''' ''' 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 "增删节点" ''' ''' 读取XML,加载树状视图 ''' 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 ''' ''' 读取XML,加载树状视图 ''' 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 ''' ''' 将树状视图导出为Xml ''' 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 ''' ''' 调试模式 ''' 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 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 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() 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