Imports System.Text Imports System.Threading Imports OpenCvSharp Imports OpenCvSharp.Extensions Imports UTS_Core.UTSModule.Test Imports UTS_Core.UTSModule Imports UTS_Core.UTSModule.Station Public Class FrmMain Implements IStatisticsObserver Implements IProcessStation Implements IProductionLine Private _ftp As FtpService Private _utsApp As UtsAppForm Private _checkStatistics As Statistics Private _snSqliteChar As Char = "|"c Private _useCamera As Boolean Private _doubleCarera As Boolean 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}" End If End Sub Public Sub UpdateFailCount(failCount As Integer) Implements IStatisticsObserver.UpdateFailCount TssLblFailCount.Text = $"Fail:{failCount:D4}" End Sub Public Sub UpdatePassCount(passCount As Integer) Implements IStatisticsObserver.UpdatePassCount TssLblPassCount.Text = $"Pass:{passCount:D4}" End Sub Public Sub UpdateValidCount(validCount As Integer) Implements IStatisticsObserver.UpdateValidCount TssLblValidCount.Text = $"Valid:{validCount:D4}" End Sub Public Sub UpdateInvalidCount(invalidCount As Integer) Implements IStatisticsObserver.UpdateInvalidCount TssLblInvalidCount.Text = $"Invalid:{invalidCount:D4}" End Sub Public Sub UpdateSumCount(sumCount As Integer) Implements IStatisticsObserver.UpdateSumCount TsLblCheckSum.Text = $"Sum:{sumCount:D4}" End Sub Public Sub UpdateYield(yield As Double) Implements IStatisticsObserver.UpdateYield Select Case yield Case > 90 TssLblYield.ForeColor = Color.DarkGreen Case > 75 TssLblYield.ForeColor = Color.Green Case > 60 TssLblYield.ForeColor = Color.Orange Case > 40 TssLblYield.ForeColor = Color.OrangeRed Case Else TssLblYield.ForeColor = Color.Red End Select TssLblYield.Text = $"Yield:{yield:F2}%" End Sub Private Sub FrmMain_Load(sender As Object, e As EventArgs) Handles Me.Load My.Application.SaveMySettingsOnExit = True _checkStatistics = New Statistics() _checkStatistics.AddStatisticsObserver(Me) _utsApp = UtsAppForm.CreateSingleton() Try If _utsApp.IsInitialized = False Then _utsApp.AddStatisticsObserver(Me) _utsApp.Initialize(ProcessStation.StationTypeEnum.AOI) _utsApp.LoadStation(My.Settings.Project, My.Settings.ProcessStation) End If Catch ex As Exception MsgBox($"Initialize UTSForm Error:{ex.Message}") Close() Return End Try Try _ftp = New FtpService(UtsRegistry.FtpHost, CInt(_utsApp.License.FtpPort), _utsApp.License.FtpUser, _utsApp.License.FtpPwd) Catch ex As Exception MsgBox($"Initialize FtpService Error:{ex.Message}") Close() Return End Try '初始化产线信息 CboProductionLines.Items.Clear() CboProductionLines.Items.AddRange(_utsApp.ProductionLines.GetLineNames()) CboProductionLines.SelectedIndex = CboProductionLines.Items.IndexOf(My.Settings.ProductionLine) _doubleCarera = My.Settings.DoubleCamera If _doubleCarera Then RdBtnDouble.Checked = True Else RdBtnSingle.Checked = True End If TsCboCameraFrame.Items.Clear() For Each siz As Size In _cameraFrame TsCboCameraFrame.Items.Add($"{siz.Width}*{siz.Height}") Next TsCboCameraFrame.SelectedIndex = My.Settings.CameraFrameIndex RtxBarcodeSn.Clear() InitImageControl() Text = $"{Application.ProductName} {Application.ProductVersion}" End Sub Private Sub InitImageControl() _imgControl(0) = PicCamera1 _imgControl(1) = PicCamera2 End Sub Private Sub FrmMain_FormClosing(sender As Object, e As FormClosingEventArgs) Handles Me.FormClosing SaveLogFile() My.Settings.CameraFrameIndex = _selectFrameSizeIndex My.Settings.DoubleCamera = _doubleCarera _utsApp.Dispose() CloseForm() End Sub Private Sub CloseForm() Text = $"Goodbye World." For i As Double = 1 To 0 Step -0.05 Thread.Sleep(50) Opacity = i Next End Sub Private Sub RtxDUT_SN_KeyDown(sender As Object, e As KeyEventArgs) Handles RtxBarcodeSn.KeyDown If e.KeyCode = Keys.Enter Then If String.IsNullOrWhiteSpace(RtxBarcodeSn.Text) = False Then My.Computer.Keyboard.SendKeys("|") e.SuppressKeyPress = True e.Handled = True End If ElseIf e.KeyCode = Keys.Space Then CommitTestResult() e.SuppressKeyPress = True e.Handled = True Console.WriteLine($"{ e.SuppressKeyPress} { e.Handled}") End If End Sub Private Function UploadFileToFtp(localPath As String, remotePath As String) As Boolean Try _ftp.FtpUpload(remotePath, localPath) Catch ex As Exception MsgBox($"上传图像[{localPath}]失败:{ex.Message}") 'todo:添加本地缓存上传失败图像,定期上传 '记录本地位置,上传文件位置,写入FTP的缓存数据库 '服务新增ftp同步任务,区分上传下载, ' ' '记录ftp命令? '只记录上传下载命令? Return False End Try Return True End Function Private Function GetImageName(barCode As String, index As Integer) As String Dim fileName As New StringBuilder fileName.Append(_utsApp.ProcessStation.ParentProject.Name) fileName.Append("_") fileName.Append(_utsApp.ProcessStation.Name) fileName.Append("_") fileName.Append(barCode) fileName.Append("_") fileName.Append($"{Now:yyyyMMdd_HHmmss}") fileName.Append("_") fileName.Append($"{index}") fileName.Append(".jpg") Return fileName.ToString() End Function Private Function SaveImageToLocal(localPath As String, index As Integer) As Boolean If _imgControl(index).Image Is Nothing Then MsgBox($"未检测到Camera[{index}] Image,录入失败") Return False End If Dim img As Image = CType(_imgControl(index).Image.Clone(), Image) Try img.Save(localPath, Imaging.ImageFormat.Jpeg) Catch ex As Exception MsgBox($"Save Camera[{index}] Image Error:{ex.Message}") Return False End Try Return True End Function Private Sub BtnCommit_Click(sender As Object, e As EventArgs) Handles BtnCommit.Click CommitTestResult() End Sub Private Sub CommitTestResult() If _utsApp.ProcessStation Is Nothing Then MsgBox($"请选择项目与测试站后再尝试录入!") Return End If If String.IsNullOrWhiteSpace(CboProductionLines.Text) Then MsgBox($"请选择生产线后再尝试录入!") Return End If Dim barcodeString As String = RtxBarcodeSn.Text.ToUpper If String.IsNullOrWhiteSpace(barcodeString) Then MsgBox($"请输入合法的序列号!") Return End If Dim barcodeList As String() = barcodeString.Split(New Char() {_snSqliteChar}, StringSplitOptions.RemoveEmptyEntries) If barcodeList.Count() = 0 Then Return For Each barcode As String In barcodeList If barcode.Length <> 8 Then MsgBox($"录入失败,条码[{barcode}]长度非法,请检查后重新录入!") Return End If Static imgDirPath As String = $"{Application.StartupPath}\Img" If IO.Directory.Exists(imgDirPath) = False Then IO.Directory.CreateDirectory(imgDirPath) Dim imgFileName As String = GetImageName(barcode, 0) Dim imgLocalPath As String = $"{imgDirPath}\{imgFileName}" Dim imgRemotePath As String = $"/uts_Manager/AUTS/{_utsApp.License.VendorName}/AOI/{_utsApp.ProcessStation.ParentProject.Index}/{imgFileName}" If SaveImageToLocal(imgLocalPath, 0) = False Then Return If UploadFileToFtp(imgLocalPath, imgRemotePath) = False Then Return Dim imgFileName2 As String = GetImageName(barcode, 1) Dim imgRemotePath2 As String = "" If _doubleCarera Then Dim imgLocalPath2 As String = $"{imgDirPath}\{imgFileName2}" If SaveImageToLocal(imgLocalPath2, 1) = False Then Return imgRemotePath2 = $"/uts_Manager/AUTS/{_utsApp.License.VendorName}/AOI/{_utsApp.ProcessStation.ParentProject.Index}/{imgFileName2}" If UploadFileToFtp(imgLocalPath2, imgRemotePath2) = False Then Return End If Try FillTestResult(barcode, imgRemotePath, imgRemotePath2) _utsApp.CommitTestResult() _checkStatistics.AddPassCount() AppendRecord(True, _utsApp.ProcessStation.ParentProject.Index, _utsApp.ProcessStation.StationID, _utsApp.TestResult.OrderID, _utsApp.TestResult.DUT_SN, "Pass") LblResult.Text = $"{_utsApp.ProcessStation.ParentProject.Index:D2}-{_utsApp.ProcessStation.StationID:D2}-{_utsApp.TestResult.OrderID:D6}-{_utsApp.TestResult.DUT_SN} 录入成功" LblResult.ForeColor = Color.Green Catch ex As Exception _checkStatistics.AddInvalidCount() MsgBox($"测试结果录入失败:{ex.Message}") LblResult.Text = $"{_utsApp.TestResult.DUT_SN} 录入失败" LblResult.ForeColor = Color.Red End Try Next TestResultCommitted() End Sub ''' ''' 填充测试记录内容,每个应用程序这个部分有所差异 ''' Public Sub FillTestResult(barcodeSn As String, imgPath As String, imgPath2 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 = barcodeSn _utsApp.TestResult.TestResult = TestResult.TestResultEnum.Pass _utsApp.TestResult.AddCustomRecord("ImagePath", imgPath) _utsApp.TestResult.AddCustomRecord("ImagePath2", imgPath2) End Sub Public Sub TestResultCommitted() RtxBarcodeSn.Focus() RtxBarcodeSn.SelectAll() End Sub Private Sub TsChangeStation_Click(sender As Object, e As EventArgs) Handles TsChangeStation.Click Try Dim filed As New Dictionary(Of String, String) From {{"ImagePath", "varchar(128)"}, {"ImagePath2", "varchar(128)"}} _utsApp.ChangeStation(filed) Catch ex As Exception MsgBox($"ChangeStation Error:{ex.Message}") End Try End Sub ''' ''' 添加提示信息 ''' ''' 校验结果 ''' 提示信息 Private Sub AppendRecord(checkResult As Boolean, pid As Integer, sid As Integer, order As Integer, barcode As String, log As String) Static recordMaxCount As Integer = 256 Static recordCount As Integer = 1 With RtxRecord .Enabled = False If recordCount >= recordMaxCount Then SaveLogFile() .Clear() recordCount = 1 End If .SelectionStart = .TextLength .SelectionColor = Color.Black .AppendText($"{recordCount:D4} ") .SelectionStart = .TextLength .SelectionColor = Color.DarkBlue .AppendText($"{Now:MMdd_HH:mm:ss} ") .SelectionStart = .TextLength .SelectionColor = Color.Black .AppendText($"{pid:D2}-") .SelectionStart = .TextLength .SelectionColor = Color.Black .AppendText($"{sid:D2} ") .SelectionStart = .TextLength .SelectionColor = Color.DarkSeaGreen .AppendText($"{order:D6} ") .SelectionStart = .TextLength .SelectionColor = Color.DarkOrange .AppendText($"{barcode,8} ") .SelectionStart = .TextLength .SelectionColor = CType(IIf(checkResult, Color.Green, Color.Red), Color) .AppendText($"{log}{vbNewLine}") recordCount += 1 .ScrollToCaret() .Enabled = True End With End Sub Private Sub SaveLogFile() Dim dirPath As String = $"{Application.StartupPath}\Log" Dim filePath As String = $"{dirPath}\Log_{Now:yyyyMMdd_HHmmss}.txt" If IO.Directory.Exists(dirPath) = False Then IO.Directory.CreateDirectory(dirPath) RtxRecord.SaveFile(filePath, RichTextBoxStreamType.TextTextOleObjs) End Sub Private Sub CboProductionLines_SelectedIndexChanged(sender As Object, e As EventArgs) Handles CboProductionLines.SelectedIndexChanged ProductionLineChanged() End Sub #Region "相机" Private ReadOnly _imgControl(1) As PictureBox Private ReadOnly _camera(1) As VideoCapture Private ReadOnly _frameChanged(1) As Boolean Private _selectFrameSizeIndex As Integer Private ReadOnly _cameraFrame() As Size = {New Size(640, 480), New Size(1280, 960), New Size(2048, 1536), New Size(2560, 1920), New Size(3200, 2400), New Size(3840, 2880)} Private Sub UpdateText(w As Integer, h As Integer, fps As Double) If InvokeRequired Then Invoke(New Action(Sub() Text = $"{Application.ProductName} {Application.ProductVersion} Camera : {w} * {h} : {CInt(fps)} Fps" End Sub)) Else Text = $"{Application.ProductName} {Application.ProductVersion} Camera : {w} * {h} : {CInt(fps)} Fps" End If End Sub ''' ''' 打开摄像头显示图像 ''' Private Sub OpenVideoThread(state As Object) Dim index As Integer = CInt(state) While _useCamera Thread.Sleep(10) If _doubleCarera = False AndAlso index = 1 Then If _camera(index) IsNot Nothing Then _camera(index).Release() _camera(index).Dispose() _camera(index) = Nothing _imgControl(index).Image = Nothing End If Continue While End If If _camera(index) Is Nothing Then _camera(index) = New VideoCapture(index) '打开默认的相机使用默认为0 '摄像头为4:3 If _selectFrameSizeIndex <> -1 Then _camera(index).FrameWidth = _cameraFrame(_selectFrameSizeIndex).Width _camera(index).FrameHeight = _cameraFrame(_selectFrameSizeIndex).Height Else _camera(index).FrameWidth = 2560 _camera(index).FrameHeight = 1920 End If _camera(index).Fps = 30 '采集率FTP _camera(index).Saturation = 60 '图像饱和度 _camera(index).Gain = 0 '图像增益 _camera(index).Contrast = 0 '对比度 _camera(index).Hue = 20 '色调 _camera(index).Brightness = 0 _camera(index).Exposure = 0 '曝光度 If _camera(index).IsOpened() = False Then Thread.Sleep(1000) Continue While End If UpdateText(_camera(index).FrameWidth, _camera(index).FrameHeight, _camera(index).Fps) End If If _frameChanged(index) Then Console.WriteLine($"分辨率切换!") _camera(index).Release() _camera(index).Dispose() _camera(index) = Nothing _frameChanged(index) = False Continue While End If Using src As New Mat If _camera(index).Read(src) = False Then Console.WriteLine($"图像为空!") _camera(index).Release() _camera(index).Dispose() _camera(index) = Nothing Continue While End If Cv2.Flip(src, src, FlipMode.XY) '反转图像 _imgControl(index).Image = src.ToBitmap End Using GC.Collect() End While End Sub Private Sub FrmMain_Shown(sender As Object, e As EventArgs) Handles Me.Shown _useCamera = True ThreadPool.QueueUserWorkItem(New WaitCallback(AddressOf OpenVideoThread), 0) ThreadPool.QueueUserWorkItem(New WaitCallback(AddressOf OpenVideoThread), 1) End Sub Private Sub TsCboCameraFrame_SelectedIndexChanged(sender As Object, e As EventArgs) Handles TsCboCameraFrame.SelectedIndexChanged _frameChanged(0) = True _frameChanged(1) = True _selectFrameSizeIndex = TsCboCameraFrame.SelectedIndex End Sub Private Sub RdBtnDouble_CheckedChanged(sender As Object, e As EventArgs) Handles RdBtnDouble.CheckedChanged _doubleCarera = RdBtnDouble.Checked End Sub Private Sub RtxRecord_TextChanged(sender As Object, e As EventArgs) Handles RtxRecord.TextChanged End Sub #End Region End Class