Files
MomoWen 027d0f8024 初始化提交
仓库转移到Gitea,初始化提交,可能丢失以前的git版本日志
2025-11-27 16:41:05 +08:00

207 lines
7.0 KiB
VB.net
Raw Permalink Blame History

This file contains ambiguous Unicode characters
This file contains Unicode characters that might be confused with other characters. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.
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
''' <summary>
''' 填充测试记录内容,每个应用程序这个部分有所差异
''' </summary>
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