Imports System.Windows.Forms Public Class form_PartNumber Dim m_PartNumber As New CPartNumber Dim m_Supplier As New CSupplier Dim m_InitOver As Boolean = False Dim strSupplierID As String = "" Dim m_RecentList_PN As New System.Windows.Forms.AutoCompleteStringCollection Dim m_RecentList_Name As New System.Windows.Forms.AutoCompleteStringCollection Dim m_RecentList_Desc As New System.Windows.Forms.AutoCompleteStringCollection Dim cam As CamSnapShot.Capture = Nothing Const VIDEODEVICE = 0 ' zero based index of video capture device to use Const VIDEOWIDTH = 1920 '// Depends on video device caps Const VIDEOHEIGHT = 1080 ' // Depends on video device caps Const VIDEOBITSPERPIXEL = 24 ' // BitsPerPixel values determined by device Dim AutoImport_CurrentRow As Integer = 0 Dim AutoImport_AutoOverWrite As Boolean = False Private Function CheckInputValid() As Boolean Dim valid As Boolean = True If tb_PartNumber.Text.Length <= 0 Then valid = False End If If tb_PartNumber.Text.Length > SEC_LENGTH.料号PN Then valid = False End If If valid = True Then tb_PartNumber.BackColor = Color.White Else tb_PartNumber.BackColor = Color.Red End If If tb_Name.Text.Length <= 0 Then tb_Name.BackColor = Color.Red valid = False Else tb_Name.BackColor = Color.White End If '检测供应商ID是否合法 Dim SupplierSplit() As String Dim SupplierID As String = "" If combo_Supplier.Text.Length > 0 Then SupplierSplit = Split(combo_Supplier.Text, ":") If SupplierSplit.Length >= 1 Then SupplierID = SupplierSplit(0) End If End If Dim SupplierIDValid As Boolean = False If SupplierID.Length > 0 Then If m_Supplier.CheckSupplierID(SupplierID, SupplierIDValid) = ERROR_CODE.SUCCESS Then If SupplierIDValid = False Then combo_Supplier.BackColor = Color.Red valid = False Else strSupplierID = SupplierID combo_Supplier.BackColor = Color.White End If Else combo_Supplier.BackColor = Color.Red valid = False MsgBox("查询""供应商ID""失败") End If Else combo_Supplier.BackColor = Color.White End If If tb_Descr.Text.Length <= 0 Then tb_Descr.BackColor = Color.Red valid = False Else tb_Descr.BackColor = Color.White End If Return valid End Function '获取供应商列表 Private Function GetSupplierList() As Boolean combo_Supplier.Items.Clear() Dim m_Supplier As New CSupplier Dim rTable As New DataTable Dim strItem As String = "" If m_Supplier.QueryAll_IDAndName(rTable) = ERROR_CODE.SUCCESS Then For row As Integer = 0 To rTable.Rows.Count - 1 strItem = rTable.Rows(row).Item(0) & ":" & rTable.Rows(row).Item(1) combo_Supplier.Items.Add(strItem) Next Return True End If Return False End Function Private Sub form_PartNumber_FormClosed(ByVal sender As Object, ByVal e As System.Windows.Forms.FormClosedEventArgs) Handles Me.FormClosed CGirdInfo.SaveRecentList("Recent_PN_PN", m_RecentList_PN) CGirdInfo.SaveRecentList("Recent_PN_Name", m_RecentList_Name) CGirdInfo.SaveRecentList("Recent_PN_Desc", m_RecentList_Desc) If Not cam Is Nothing Then cam.Dispose() End If cam = Nothing End Sub Private Sub form_PartNumber_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load CGirdInfo.LoadRecentList("Recent_PN_PN", m_RecentList_PN) CGirdInfo.LoadRecentList("Recent_PN_Name", m_RecentList_Name) CGirdInfo.LoadRecentList("Recent_PN_Desc", m_RecentList_Desc) AddDataToSlqDic = New Dictionary(Of String, (String, Object())) tb_PartNumber.AutoCompleteCustomSource = m_RecentList_PN tb_Name.AutoCompleteCustomSource = m_RecentList_Name tb_Descr.AutoCompleteCustomSource = m_RecentList_Desc If CBool(Current_Rights(COL_RIGHTS.料号管理) And RIGHTS.READ) = False Then bt_Query.Enabled = False End If If CBool(Current_Rights(COL_RIGHTS.料号管理) And RIGHTS.WRITE) = False Then bt_Save.Enabled = False End If GetSupplierList() Me.Left = My.Settings.FORM_PARTNUMBER_X Me.Top = My.Settings.FORM_PARTNUMBER_Y m_InitOver = True End Sub Private Sub bt_Browse_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles bt_Browse.Click Dim ofd As New OpenFileDialog() If ofd.ShowDialog() <> DialogResult.OK Then Return PictureBox1.BackgroundImage = Image.FromFile(ofd.FileName) End Sub Private Sub AddLog(ByVal text As String) Dim index As Integer = lstb_Log.Items.Add(Now.ToString & ":" & text) lstb_Log.SelectedIndex = index End Sub '记录要录入对数据 Public AddDataToSlqDic As Dictionary(Of String, (String, Object())) Private Sub bt_Save_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles bt_Save.Click If tb_PartNumber.Text.Length > 0 Then m_RecentList_PN.Add(tb_PartNumber.Text) End If If tb_Name.Text.Length > 0 Then m_RecentList_Name.Add(tb_Name.Text) End If If tb_Descr.Text.Length > 0 Then m_RecentList_Desc.Add(tb_Descr.Text) End If If m_RecentList_PN.Count > 10 Then m_RecentList_PN.RemoveAt(0) End If If m_RecentList_Name.Count > 10 Then m_RecentList_Name.RemoveAt(0) End If If m_RecentList_Desc.Count > 10 Then m_RecentList_Desc.RemoveAt(0) End If lbl_QueryInfo.Text = "" '首先检查料号信息完整性 If CheckInputValid() = False Then MsgBox("输入属性存在错误！请见红色背景提示") Return End If '检测料号唯一性 Dim UpdateMode As Boolean = False Dim isExist As Boolean = True If m_PartNumber.CheckPartNumber(tb_PartNumber.Text, isExist) = ERROR_CODE.SUCCESS Then If isExist = True Then tb_PartNumber.BackColor = Color.Red If AutoImport_AutoOverWrite = False Then 'Momo 2021-08-10 如果选择自动覆盖，就不弹框 '==Momo 20180322 If MsgBox("当前料号已经存在: " & tb_PartNumber.Text & vbNewLine & "是否继续覆盖原数据?", MsgBoxStyle.OkCancel Or MsgBoxStyle.DefaultButton2) <> MsgBoxResult.Ok Then Return End If End If '==Momo 20180322 UpdateMode = True tb_PartNumber.BackColor = Color.White End If Else MsgBox("访问数据库失败: 请检查网络连接或联系管理员!") Return End If '保存料号 Dim result As ERROR_CODE 'If System.IO.File.Exists(tb_PicPath.Text) = True Then If Not (PictureBox1.BackgroundImage Is Nothing) Then Dim imageSize As Integer = PictureBox1.Width * PictureBox1.Height * Image.GetPixelFormatSize(System.Drawing.Imaging.PixelFormat.Format24bppRgb) / 8 Dim PicBytes(imageSize * 2) As Byte Dim pt As Point = PictureBox1.Location If mdl_Common.GetBytesFromImage(mdl_Common.ZoomImage(PictureBox1.BackgroundImage, PictureBox1.Bounds), PicBytes) = False Then MsgBox("获取图像失败!") Return End If If UpdateMode = True Then result = m_PartNumber.UpdateItem(tb_PartNumber.Text, tb_Name.Text, tb_Descr.Text, combo_Unit.Text, num_Weight.Value, PicBytes, strSupplierID) Else result = m_PartNumber.AddItem(tb_PartNumber.Text, tb_Name.Text, tb_Descr.Text, combo_Unit.Text, num_Weight.Value, PicBytes, strSupplierID) End If Else If UpdateMode = True Then result = m_PartNumber.UpdateItem(tb_PartNumber.Text, tb_Name.Text, tb_Descr.Text, combo_Unit.Text, num_Weight.Value, Nothing, strSupplierID) Else result = m_PartNumber.AddItem(tb_PartNumber.Text, tb_Name.Text, tb_Descr.Text, combo_Unit.Text, num_Weight.Value, strSupplierID) End If End If If result = ERROR_CODE.SUCCESS Then '查询保存序号 Dim SaveIndex As Integer = 0 Dim minIndex As Integer = 0 Dim maxIndex As Integer = 0 Dim TotalCount As Integer = 0 result = m_PartNumber.QueryInformation(TotalCount, minIndex, maxIndex) If result = ERROR_CODE.SUCCESS Then m_PartNumber.QueryItemIndex(tb_PartNumber.Text, SaveIndex) If result = ERROR_CODE.SUCCESS Then lbl_QueryInfo.Text = "保存序号: " & SaveIndex & ", 最小序号: " & minIndex & ", 最大序号: " & maxIndex & ", 总条数: " & TotalCount AddLog("成功添加: " & SaveIndex & "," & tb_PartNumber.Text & "," & tb_Name.Text & "," & tb_Descr.Text & "," & combo_Unit.Text & "," & num_Weight.Value & "," & strSupplierID) Else MsgBox("保存失败： ""读取总条数失败!""") End If Else MsgBox("保存失败： ""读取保存信息失败!""") End If ElseIf result = ERROR_CODE.NORIGHT Then MsgBox("保存失败： ""无访问权限!""") Else MsgBox("保存失败: 请检查网络连接或联系管理员!") End If End Sub Private Sub bt_Query_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles bt_Query.Click tb_Name.Text = "" tb_Descr.Text = "" combo_Unit.Text = "" num_Weight.Value = 0 combo_Supplier.Text = "" PictureBox1.BackgroundImage = Nothing Dim 物料名称 As String = "" Dim 规格描述 As String = "" Dim 单位 As String = "" Dim 单重 As Double = 0 Dim 图片(0) As Byte Dim 供应商ID As String = "" If m_PartNumber.QueryItem(tb_PartNumber.Text, 物料名称, 规格描述, 单位, 单重, 图片, 供应商ID) = ERROR_CODE.SUCCESS Then tb_Name.Text = 物料名称 tb_Descr.Text = 规格描述 combo_Unit.Text = 单位 num_Weight.Value = 单重 combo_Supplier.Text = 供应商ID PictureBox1.BackgroundImage = GetImageFromBytes(图片) End If End Sub Private Sub bt_New_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles bt_New.Click tb_PartNumber.Text = "" tb_Name.Text = "" tb_Descr.Text = "" combo_Unit.Text = "pcs" num_Weight.Value = 0 combo_Supplier.Text = "" PictureBox1.BackgroundImage = Nothing End Sub Private Sub form_PartNumber_LocationChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.LocationChanged If m_InitOver = True Then My.Settings.FORM_PARTNUMBER_X = Me.Left My.Settings.FORM_PARTNUMBER_Y = Me.Top My.Settings.Save() End If End Sub Private Sub chk_EnableCam_CheckedChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles chk_EnableCam.CheckedChanged If m_InitOver = False Then Return Try If chk_EnableCam.Checked = True Then Dim rc As Rectangle = picBox_Preview.ClientRectangle ''保持长宽比 'Dim scaleX As Double = VIDEOWIDTH / rc.Width 'Dim scaleY As Double = VIDEOHEIGHT / rc.Height 'Dim scale As Double = Math.Min(scaleX, scaleY) 'Dim rWidth As Double = rc.Width * scale 'Dim rHeight As Double = rc.Height * scale ''Dim offsetX As Double = (rc.Width - rWidth) / 2 ''Dim offsetY As Double = (rc.Height - rHeight) / 2 'cam = New CamSnapShot.Capture(VIDEODEVICE, rWidth, rHeight, VIDEOBITSPERPIXEL, picBox_Preview) 'cam = New CamSnapShot.Capture(VIDEODEVICE, VIDEOWIDTH, VIDEOHEIGHT, VIDEOBITSPERPIXEL, picBox_Preview) cam = New CamSnapShot.Capture(VIDEODEVICE, rc.Width, rc.Height, VIDEOBITSPERPIXEL, picBox_Preview) Else If Not cam Is Nothing Then cam.Dispose() End If cam = Nothing End If Catch ex As Exception End Try End Sub 'Private Sub ConnectCam() ' If vcx.Connected Then vcx.Connected = False ' vcx.AudioDeviceIndex = -1 ' vcx.CaptureAudio = False ' vcx.VideoDeviceIndex = 0 'cb1.SelectedIndex ' vcx.UseVideoFilter = VIDEOCAPXLib.vcxUseVideoFilterEnum.vcxBoth ' vcx.Connected = True ' vcx.Preview = True ' vcx.SetVideoFormat(640, 480) 'End Sub 'Private Sub DisConnectCam() ' vcx.Preview = False ' vcx.Connected = False 'End Sub Private Sub bt_CaptureImage_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles bt_CaptureImage.Click 'PictureBox1.BackgroundImage = vcx.GrabFrame Try PictureBox1.BackgroundImage = cam.SnapShot Catch ex As Exception End Try End Sub Private Function vcx() As Object Throw New NotImplementedException End Function Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click grid_ImportPartNoList.ExportToExcel("d:\import.xls") End Sub Private Sub grid_ImportPartNoList_Click(Sender As Object, e As EventArgs) Handles grid_ImportPartNoList.Click AutoImport_CurrentRow = grid_ImportPartNoList.MouseRow tb_SelectedRow.Text = AutoImport_CurrentRow GetItemFromGrid(AutoImport_CurrentRow) End Sub Private Sub GetItemFromGrid(TargetRow As Integer) tb_PartNumber.Text = grid_ImportPartNoList.Cell(AutoImport_CurrentRow, 1).Text tb_Name.Text = grid_ImportPartNoList.Cell(AutoImport_CurrentRow, 2).Text tb_Descr.Text = grid_ImportPartNoList.Cell(AutoImport_CurrentRow, 3).Text combo_Unit.Text = "Pcs" num_Weight.Text = grid_ImportPartNoList.Cell(AutoImport_CurrentRow, 5).Text End Sub Private Sub grid_ImportPartNoList_Load(sender As Object, e As EventArgs) Handles grid_ImportPartNoList.Load End Sub Private Sub grid_ImportPartNoList_MouseMove(Sender As Object, e As MouseEventArgs) Handles grid_ImportPartNoList.MouseMove tb_CurrentLocation.Text = grid_ImportPartNoList.MouseRow & " , " & grid_ImportPartNoList.MouseCol End Sub Private Sub btn_ImportAll_Click(sender As Object, e As EventArgs) Handles btn_ImportAll.Click Dim tempCurrentRowPN As String = "" 'AddDataToSlqDic.Clear() If cb_AutoOverWrite.Checked Then AutoImport_AutoOverWrite = True Else AutoImport_AutoOverWrite = False End If For i = 1 To grid_ImportPartNoList.Rows - 1 If String.IsNullOrEmpty(grid_ImportPartNoList.Cell(i, 0).Text) Then Continue For bt_New.PerformClick() AutoImport_CurrentRow = i tempCurrentRowPN = grid_ImportPartNoList.Cell(i, 1).Text If tempCurrentRowPN <> "" Then grid_ImportPartNoList.Cell(i, 1).SetFocus() 'grid_ImportPartNoList.Focus() GetItemFromGrid(i) If Val(grid_ImportPartNoList.Cell(i, 5).Text) < 0.01 Then grid_ImportPartNoList.Cell(i, 5).Text = "0.01" num_Weight.Text = grid_ImportPartNoList.Cell(AutoImport_CurrentRow, 5).Text grid_ImportPartNoList.Cell(i, 7).Text = i grid_ImportPartNoList.Cell(i, 8).Text = "OK" strSupplierID = "01" bt_Save.PerformClick() 'AddLog("成功添加: " & i & "," & tb_PartNumber.Text & "," & tb_Name.Text & "," & tb_Descr.Text & "," & combo_Unit.Text & "," & num_Weight.Value & "," & strSupplierID) Else Exit For AddLog("添加完成") End If Next ' Console.WriteLine("添加完成") End Sub Private Sub cb_AutoOverWrite_CheckedChanged(sender As Object, e As EventArgs) Handles cb_AutoOverWrite.CheckedChanged If cb_AutoOverWrite.Checked Then AutoImport_AutoOverWrite = True Else AutoImport_AutoOverWrite = False End If End Sub Private Sub btnTips_Click(sender As Object, e As EventArgs) Handles btnTips.Click Dim strTips = "提示：" & vbCrLf & vbCrLf & "（1），从ERP系统导出料号到Excel表格" & vbCrLf & "（2），表格顺序为：1-料号 2-品名 3-规格描述 4-单位 5-单价 " & vbCrLf & "（3），将Excel数据复制黏贴到表格中" & vbCrLf & "（4），点击 自动导入 按钮开始导入" & vbCrLf MsgBox(strTips, MsgBoxStyle.OkOnly + MsgBoxStyle.Information, "料号导入操作提示") End Sub Private Sub grid_ImportPartNoList_CellChange(Sender As Object, e As FlexCell.Grid.CellChangeEventArgs) Handles grid_ImportPartNoList.CellChange If e.Row = 0 AndAlso e.Col = 0 Then Return If String.IsNullOrEmpty(grid_ImportPartNoList.Cell(e.Row, 0).Text) Then grid_ImportPartNoList.Cell(e.Row, 0).Text = e.Row.ToString End If End Sub Private Sub Button2_Click(sender As Object, e As EventArgs) Handles Button2.Click strSupplierID = "01" AddDataToSlqDic.Clear() ' insert into Table Dim result As String = " START TRANSACTION;" & vbLf Dim listCoun As New List(Of Integer) For i = 1 To grid_ImportPartNoList.Rows - 1 If String.IsNullOrEmpty(grid_ImportPartNoList.Cell(i, 0).Text) AndAlso String.IsNullOrEmpty(grid_ImportPartNoList.Cell(i, 1).Text) Then Continue For result = result & m_PartNumber.GetAddItemCmd(grid_ImportPartNoList.Cell(i, 1).Text, grid_ImportPartNoList.Cell(i, 2).Text, grid_ImportPartNoList.Cell(i, 3).Text, grid_ImportPartNoList.Cell(i, 4).Text, grid_ImportPartNoList.Cell(i, 5).Text, strSupplierID) & ";" & vbLf listCoun.Add(i) If i Mod 50 = 0 Then result = result & " COMMIT;" If SQL_Transaction(COL_RIGHTS.料号管理, result) Then For Each item In listCoun grid_ImportPartNoList.Cell(item, 8).Text = "OK" Next Else MsgBox($"导入失败:已导入({i - 50}/{grid_ImportPartNoList.Rows - 1}){vbLf }{mdl_SQLAccessManage.Transactionmsg}") Return End If Console.WriteLine(result) result = " START TRANSACTION;" & vbLf End If Next result = result & " COMMIT;" If SQL_Transaction(COL_RIGHTS.料号管理, result) Then For Each item In listCoun grid_ImportPartNoList.Cell(item, 8).Text = "OK" Next Else Dim num As Integer = (grid_ImportPartNoList.Rows - 1) Mod 50 MsgBox($"导入失败:已导入({(grid_ImportPartNoList.Rows - 1 - num)}/{grid_ImportPartNoList.Rows - 1}){vbLf }{mdl_SQLAccessManage.Transactionmsg}") Return End If MsgBox("导入成功") Console.WriteLine(result) End Sub End Class