📄 frmproduct1.frm
字号:
Height = 210
Index = 4
Left = 240
TabIndex = 29
Top = 960
Width = 1605
End
Begin VB.Label Label2
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "商品名称(CH)："
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 210
Index = 3
Left = 240
TabIndex = 28
Top = 480
Width = 1605
End
End
Begin VB.Image Image1
BorderStyle = 1 'Fixed Single
Height = 6195
Left = 8760
Stretch = -1 'True
Top = 240
Width = 6195
End
End
Attribute VB_Name = "frmProduct1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
'是否改动过记录，ture为改过
Dim mblChange As Boolean
Public txtsql As String
Dim sSql As String
Dim intCount As Integer
Dim Msgtext As String
Dim mrcc As ADODB.Recordset
Public mrimage As ADODB.Recordset
Private ScrollVert As Boolean, ScrollHor As Boolean
Private ZoomFact As Single
Private IsRightButt As Boolean
Const ZFactorC As Byte = 100 ' percentage increase
Const ScrollFactorC As Byte = 20
Private Sub cmdDel_Click()
Dim mrc As ADODB.Recordset
If MsgBox("真的要删除这条文件记录么？", vbOKCancel + vbExclamation, "警告") = vbOK Then
txtsql = "delete from products where ProductID='" & Trim(txtNo.Text) & "'"
Set mrc = ExecuteSQL(txtsql, Msgtext)
Unload Me
Unload frmProduct
frmProduct.txtsql = "select * from products"
frmProduct.Show
End If
End Sub
Private Sub cmdExit_Click()
If mblChange And cmdSave.Enabled Then
If MsgBox("保存当前记录的变化吗？", vbOKCancel + vbExclamation, "警告") = vbOK Then
'保存
Call cmdSave_Click
End If
End If
Unload Me
End Sub
Private Sub cmdSave_Click()
Dim intCount As Integer
Dim SMeg As String
Dim mrc As ADODB.Recordset
Dim Msgtext As String
For intCount = 0 To 3
If Trim(txtItem(intCount) & " ") = "" Then
Select Case intCount
Case 0
SMeg = "商品名称(CH)"
Case 1
SMeg = "商品名称(EN)"
Case 2
SMeg = "产品规格"
Case 3
SMeg = "产品材料"
End Select
SMeg = SMeg & "不能为空！"
MsgBox SMeg, vbOKOnly + vbExclamation, "警告"
txtItem(intCount).SetFocus
Exit Sub
End If
Next intCount
If Trim(txtItem(4)) = "" Then
SMeg = "工厂名称"
SMeg = SMeg & " 请选择工厂名称"
MsgBox SMeg, vbOKOnly + vbExclamation, "警告"
Me.Combo1.SetFocus
Exit Sub
End If
For intCount = 5 To 6
If Trim(txtItem(intCount) & " ") = "" Then
Select Case intCount
Case 5
SMeg = "工厂货号"
Case 6
SMeg = "公司货号"
End Select
SMeg = SMeg & "不能为空！"
MsgBox SMeg, vbOKOnly + vbExclamation, "警告"
txtItem(intCount).SetFocus
Exit Sub
End If
Next intCount
If Not IsNumeric(Trim(txtItem(7))) Then
SMeg = "出厂价格"
SMeg = SMeg & "请输入数字！"
MsgBox SMeg, vbOKOnly + vbExclamation, "警告"
txtItem(7).SetFocus
Exit Sub
End If
For intCount = 8 To 20
If Trim(txtItem(intCount) & " ") = "" Then
Select Case intCount
Case 8
SMeg = "价格单位"
Case 9
SMeg = "最少数量"
Case 10
SMeg = "包装尺码"
Case 11
SMeg = "每箱体积"
Case 12
SMeg = "毛重"
Case 13
SMeg = "净重"
Case 14
SMeg = "包装方式"
Case 15
SMeg = "包装规格"
Case 16
SMeg = "内箱数量"
Case 17
SMeg = "外箱数量"
Case 18
SMeg = "20'装箱数"
Case 19
SMeg = "40'装箱数"
Case 20
SMeg = "40'HQ装箱数"
End Select
SMeg = SMeg & "不能为空！"
MsgBox SMeg, vbOKOnly + vbExclamation, "警告"
txtItem(intCount).SetFocus
Exit Sub
End If
Next intCount
If gintGmode = 1 Then
txtsql = "select * from products where cn_ProductName ='" & Trim(txtItem(0)) & "' and en_ProductName = '" & Trim(txtItem(1)) & "'"
Set mrc = ExecuteSQL(txtsql, Msgtext)
If mrc.EOF = False Then
MsgBox "已经存在相同内容的记录！", vbOKOnly + vbExclamation, "警告"
txtItem(0).SetFocus
Exit Sub
End If
mrc.Close
End If
If gintGmode = 2 Then
'先删除已有记录
' txtsql = "delete from products where ProductID ='" & Trim(txtNo) & "'"
' Set mrc = ExecuteSQL(txtsql, MsgText)
txtsql = "update products set cn_ProductName='" & Trim(txtItem(0)) & "',en_ProductName='" & Trim(txtItem(1)) _
& "',产品规格='" & Trim(txtItem(2)) & "',产品材料='" & Trim(txtItem(3)) & "',工厂编号='" & Trim(txtItem(4)) _
& "',工厂货号='" & Trim(txtItem(5)) & "',公司货号='" & Trim(txtItem(6)) & "',出厂价格=" & Trim(txtItem(7)) _
& ",价格单位='" & Trim(txtItem(8)) & "',最少数量='" & Trim(txtItem(9)) & "',包装尺码='" & Trim(txtItem(10)) _
& "',每箱体积='" & Trim(txtItem(11)) & "',毛重='" & Trim(txtItem(12)) & "',净重='" & Trim(txtItem(13)) _
& "',包装方式='" & Trim(txtItem(14)) & "',包装规格='" & Trim(txtItem(15)) & "',内箱数量='" & Trim(txtItem(16)) _
& "',外箱数量='" & Trim(txtItem(17)) & "',[20'装箱数]='" & Trim(txtItem(18)) & "',[40'装箱数]='" & Trim(txtItem(19)) _
& "',[40'HQ装箱数]='" & Trim(txtItem(20)) & "',Productmemo='" & Trim(txtItem(21)) _
& "' where ProductID='" & Trim(txtNo) & "'"
Set mrc = ExecuteSQL(txtsql, Msgtext)
Unload Me
If flagGedit Then
Unload frmProduct
End If
frmProduct.txtsql = "select * from products"
frmProduct.Show
Exit Sub
End If
'再加入新记录
txtsql = "select * from products"
Set mrc = ExecuteSQL(txtsql, Msgtext)
mrc.AddNew
mrc.Fields(0) = txtNo
For intCount = 0 To 21
mrc.Fields(intCount + 1) = Trim(txtItem(intCount))
Next intCount
mrc.Update
mrc.Close
If gintGmode = 1 Then
Dim intAddpic As Integer
txtsql = "select photo from products where productid='" & Trim(txtNo) & "'"
Set mrimage = ExecuteSQL(txtsql, Msgtext)
intAddpic = MsgBox("是否添加产品图片(Y/N)?", vbYesNo + vbExclamation, "添加商品信息")
If intAddpic = vbYes Then
Dim DiskFile As String
'如果没有选择员工，则返回
If frmProduct1.txtNo <= 0 Then
MsgBox "请选择员工"
Unload Me
Exit Sub
End If
'使用CommonDialog控件读取图像文件
CommonDialog1.Filter = "Graphics Files|*.bmp;*.ico;*.jpg;*.gif"
CommonDialog1.ShowOpen
DiskFile = CommonDialog1.FileName
If DiskFile = "" Then
MsgBox "请选择照片文件"
Unload Me
Exit Sub
End If
'存储并显示照片
Call SaveImage(DiskFile, frmProduct1.mrimage)
Call ShowImage(frmProduct1.Image1, frmProduct1.mrimage)
End If
For intCount = 0 To 21
txtItem(intCount) = ""
Next intCount
mblChange = False
MsgBox "添加商品信息成功！", vbOKOnly + vbExclamation, "添加商品信息"
Unload Me
If flagGedit Then
Unload frmProduct
frmProduct.txtsql = "select * from products"
frmProduct.Show
End If
ElseIf gintGmode = 2 Then
Unload Me
If flagGedit Then
Unload frmProduct
End If
frmProduct.txtsql = "select * from products"
frmProduct.Show
End If
End Sub
Private Sub Combo1_Click()
txtItem(4).Text = Trim(Combo1.Text)
End Sub
Private Sub Form_Load()
If gintGmode = 1 Then
Me.Caption = Me.Caption & "添加"
txtNo = GetRkno()
Me.txtItem(4).Visible = False
Combo1.Clear
Dim mrcc1 As ADODB.Recordset
txtsql = "select DISTINCT cn_CompanyName from suppliers"
Set mrcc1 = ExecuteSQL(txtsql, Msgtext)
If Not mrcc1.EOF Then
Do While Not mrcc1.EOF
Combo1.AddItem Trim(mrcc1.Fields(0))
mrcc1.MoveNext
Loop
Else
MsgBox "请先进行供应商信息设置！", vbOKOnly + vbExclamation, "警告"
Exit Sub
End If
mrcc1.Close
ElseIf gintGmode = 2 Then
Set mrcc = ExecuteSQL(txtsql, Msgtext)
If mrcc.EOF = False Then
With mrcc
txtNo = .Fields(0)
For intCount = 0 To 21
If Not IsNull(.Fields(intCount + 1)) Then
txtItem(intCount) = .Fields(intCount + 1)
End If
Next intCount
End With
End If
Me.Combo1.Clear
'Dim mrcc1 As ADODB.Recordset
txtsql = "select DISTINCT cn_CompanyName from suppliers"
Set mrcc1 = ExecuteSQL(txtsql, Msgtext)
If Not mrcc1.EOF Then
Do While Not mrcc1.EOF
Combo1.AddItem Trim(mrcc1.Fields(0))
mrcc1.MoveNext
Loop
Else
MsgBox "请先进行供应商信息设置！", vbOKOnly + vbExclamation, "警告"
Exit Sub
End If
mrcc1.Close
Me.Combo1.Text = mrcc.Fields(5)
mrcc.Close
txtsql = "select photo from products where productid='" & Trim(txtNo) & "'"
Set mrimage = ExecuteSQL(txtsql, Msgtext)
Call ShowImage(Image1, mrimage)
Me.Caption = Me.Caption & "修改"
'Me.Width = Me.Width + 5000
Me.txtItem(4).Visible = False
ElseIf gintGmode = 3 Then
Set mrcc = ExecuteSQL(txtsql, Msgtext)
If mrcc.EOF = False Then
With mrcc
txtNo = mrcc.Fields(0)
For intCount = 0 To 21
If Not IsNull(.Fields(intCount + 1)) Then
txtItem(intCount) = .Fields(intCount + 1)
txtItem(intCount).Enabled = False
End If
Next intCount
End With
cmdSave.Enabled = False
Combo1.Visible = False
Me.Width = Me.Width * 2 - 2000
End If
mrcc.Close
txtsql = "select photo from products where productid='" & Trim(txtNo) & "'"
Set mrimage = ExecuteSQL(txtsql, Msgtext)
Call ShowImage(Image1, mrimage)
Me.Caption = Me.Caption & "查看"
Me.cmdDel.Visible = True
End If
mblChange = False
End Sub
Private Sub Form_Unload(Cancel As Integer)
gintGmode = 0
End Sub
Private Sub Image1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
If gintGmode = 2 Or gintGmode = 3 Then
'单击左键，则关闭照片管理菜单
If Button = 1 Then
If FrmPhotoMenu.Visible = True Then
Unload FrmPhotoMenu
End If
End If
'单击右键，打开照片管理菜单
If Button = 2 Then
' If txtItem(1) <= "" Then
' Exit Sub
' End If
FrmPhotoMenu.Left = X + Image1.Left + 200 ' - 1610
FrmPhotoMenu.Top = Y + Image1.Top + 1900
FrmPhotoMenu.Show
End If
End If
End Sub
Private Sub txtItem_Change(Index As Integer)
'有变化设置gblchange
mblChange = True
End Sub
Private Sub txtItem_GotFocus(Index As Integer)
txtItem(Index).SelStart = 0
txtItem(Index).SelLength = Len(txtItem(Index))
txtItem(Index).BackColor = &HFFFF&
End Sub
Private Sub txtItem_KeyDown(Index As Integer, KeyCode As Integer, Shift As Integer)
EnterToTab KeyCode
End Sub
Private Sub txtItem_LostFocus(Index As Integer)
txtItem(Index).BackColor = &H80000005
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -