542 lines
18 KiB
VB.net
542 lines
18 KiB
VB.net
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
|
||
|
||
''' <summary>
|
||
''' 填充测试记录内容，每个应用程序这个部分有所差异
|
||
''' </summary>
|
||
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
|
||
|
||
''' <summary>
|
||
''' 添加提示信息
|
||
''' </summary>
|
||
''' <param name="checkResult">校验结果</param>
|
||
''' <param name="log">提示信息</param>
|
||
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
|
||
|
||
|
||
''' <summary>
|
||
''' 打开摄像头显示图像
|
||
''' </summary>
|
||
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
|