Imports UTS_Core.UTSModule Imports UTS_Core.UTSModule.Test Public Class FrmMain Implements IProcessStation Implements IProductionLine Private _utsApp As UtsAppForm Public Sub ProductionLineChanged() Implements IProductionLine.ProductionLineChanged TssLblProductionLine.Text = CboProductionLines.Text My.Settings.ProductionLine = CboProductionLines.Text End Sub Public Sub StationChanged() Implements IProcessStation.StationChanged My.Settings.Project = _utsApp.ProcessStation.ParentProject.Name My.Settings.ProcessStation = _utsApp.ProcessStation.Name UpdateStation(_utsApp.ProcessStation.ParentProject.Name, _utsApp.ProcessStation.Name) End Sub Public Sub UpdateStation(projectName As String, stationName As String) If String.IsNullOrWhiteSpace(projectName) OrElse String.IsNullOrWhiteSpace(stationName) Then TssLblStaion.Text = $"Invalid Station" Else TssLblStaion.Text = $"{projectName} - {stationName}" lab_ModelName.Text = $"{projectName} - {stationName}" End If End Sub Private Sub Form1_Load(sender As Object, e As EventArgs) Handles Me.Load '自动保存设置 My.Application.SaveMySettingsOnExit = True '初始化UTS窗体信息,失败则关闭窗体 If InitializeUtsApp() = False Then Return '初始化界面信息 InitializeForm() End Sub Private Function InitializeUtsApp() As Boolean _utsApp = UtsAppForm.CreateSingleton Try If _utsApp.IsInitialized = False Then _utsApp.AddStatisticsObserver(Me) _utsApp.Initialize() _utsApp.LoadStation(My.Settings.Project, My.Settings.ProcessStation) End If Catch ex As Exception MsgBox($"Initialize UTSForm Error:{ex.Message}") Close() Return False End Try Return True End Function Private Sub InitializeForm() CboProductionLines.Items.Clear() CboProductionLines.Items.AddRange(_utsApp.ProductionLines.GetLineNames()) CboProductionLines.SelectedIndex = CboProductionLines.Items.IndexOf(My.Settings.ProductionLine) TxtFirstRecord.Clear() RtxLog.Clear() Text = $"{Application.ProductName} {Application.ProductVersion} User:{_utsApp.Account.UserName}" End Sub Private Sub CboProductionLine_DropDown(sender As Object, e As EventArgs) Handles CboProductionLines.DropDown '填充内容 CboProductionLines.Items.Clear() CboProductionLines.Items.AddRange(_utsApp.ProductionLines.GetLineNames()) End Sub Private Sub CboProductionLines_SelectedIndexChanged(sender As Object, e As EventArgs) Handles CboProductionLines.SelectedIndexChanged ProductionLineChanged() End Sub Private Sub Btn_OpenProject_Click(sender As Object, e As EventArgs) Handles btn_OpenProject.Click Try _utsApp.ChangeStation() Catch ex As Exception MsgBox($"ChangeStation Error:{ex.Message}") End Try End Sub Private Sub Tb_FirstRecord_KeyDown(sender As Object, e As KeyEventArgs) Handles TxtFirstRecord.KeyDown If e.KeyCode = Keys.Enter Then SaveTestResult() e.SuppressKeyPress = True e.Handled = True End If End Sub Private Sub Btn_StartProgramming_Click(sender As Object, e As EventArgs) Handles btn_StartProgramming.Click SaveTestResult() End Sub Private Sub SaveTestResult() If _utsApp.ProcessStation Is Nothing Then MsgBox($"请选择项目与测试站后再尝试录入!") Return End If If String.IsNullOrWhiteSpace(CboProductionLines.Text) Then MsgBox($"请选择生产线后再尝试录入!") Return End If Dim barcodeString As String = TxtFirstRecord.Text If String.IsNullOrWhiteSpace(barcodeString) Then MsgBox($"请输入PCB序号!") Return End If Dim saveDb As Boolean Try FillTestResult(barcodeString) _utsApp.CommitTestResult(uniqueRecord:=True) saveDb = True Catch ex As Exception MessageBox.Show($"测试结果录入失败:{ex.Message}", $"录入异常", MessageBoxButtons.OK, MessageBoxIcon.Information, MessageBoxDefaultButton.Button1) saveDb = False End Try Static inputCount As Integer = 0 inputCount += 1 : If inputCount > 9999 Then inputCount = 0 RtxLog.SelectionStart = 0 RtxLog.SelectionLength = RtxLog.TextLength RtxLog.SelectionColor = Color.Gray If saveDb Then lab_Result.ForeColor = Color.Green lab_Result.Text = $"{barcodeString}{vbCrLf}Pass" RtxLog.SelectionStart = RtxLog.TextLength RtxLog.SelectionColor = Color.Green AppendRecord($"{inputCount:D4}.BarcodeSn:{barcodeString},录入成功!") Else lab_Result.ForeColor = Color.Red lab_Result.Text = $"{barcodeString}{vbCrLf}Fail" RtxLog.SelectionStart = RtxLog.TextLength RtxLog.SelectionColor = Color.Red AppendRecord($"{inputCount:D4}.BarcodeSn:{barcodeString},录入失败!") End If TxtFirstRecord.Focus() TxtFirstRecord.SelectAll() End Sub Public Sub AppendRecord(logString As String) If RtxLog.InvokeRequired Then '判断是否需要开委托 RtxLog.Invoke(New Action(Of String)(AddressOf AppendRecord), New Object() {logString}) Return End If With RtxLog If .Lines.Length > 256 Then '超过上限则移除最初行内容 .ReadOnly = False .SelectionStart = 0 .SelectionLength = .GetFirstCharIndexFromLine(1) .SelectedText = String.Empty .ReadOnly = True .SelectionStart = .TextLength End If .AppendText($"{Now:yyyy:MM:dd HH:mm:ss} - {logString}{vbNewLine}") .ScrollToCaret() End With End Sub ''' ''' 填充测试记录内容,每个应用程序这个部分有所差异 ''' Public Sub FillTestResult(barcodeString As String) _utsApp.TestResult.ResetTestResult() '产线索引 Dim lineID As Integer = _utsApp.ProductionLines(CboProductionLines.Text).ID _utsApp.TestResult.ProductionLineID = lineID '测试开始时间 _utsApp.TestResult.StartTime = Now _utsApp.TestResult.DUT_SN = barcodeString _utsApp.TestResult.TestResult = TestResult.TestResultEnum.Pass End Sub Private Sub lab_ModelName_Click(sender As Object, e As EventArgs) Handles lab_ModelName.Click Try DbConnect.DbConnector.SaveTestLogToRemote(UtsDb.RemotePrivateDb, "", Nothing, Nothing) Catch ex As Exception Console.WriteLine($"Save Error:{ex.Message}") End Try End Sub End Class