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
|