📄 frmfp.frm
字号:
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Mode = 0
Value = 0 'False
cBack = -2147483633
End
Begin VB.Label Label5
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "地 址："
Height = 180
Left = 360
TabIndex = 12
Top = 1380
Width = 720
End
Begin VB.Label lbName
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "名 称："
Height = 180
Left = 360
TabIndex = 11
Top = 435
Width = 720
End
Begin VB.Label Label3
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "电 话："
Height = 180
Left = 360
TabIndex = 10
Top = 915
Width = 720
End
End
Begin MySuperMarket.XPButton cmdDel
Height = 345
Left = 3600
TabIndex = 15
Top = 660
Width = 1095
_ExtentX = 1931
_ExtentY = 609
Caption = "删除(&D)"
CapAlign = 2
BackStyle = 2
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋体"
Size = 9
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Mode = 0
Value = 0 'False
cBack = -2147483633
End
Begin MySuperMarket.XPButton cmdEdit
Height = 345
Left = 2400
TabIndex = 16
Top = 660
Width = 1095
_ExtentX = 1931
_ExtentY = 609
Caption = "修改(&E)"
CapAlign = 2
BackStyle = 2
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋体"
Size = 9
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Mode = 0
Value = 0 'False
cBack = -2147483633
End
Begin MySuperMarket.XPButton cmdAdd
Height = 345
Left = 1200
TabIndex = 17
Top = 660
Width = 1095
_ExtentX = 1931
_ExtentY = 609
Caption = "添加(&A)"
CapAlign = 2
BackStyle = 2
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋体"
Size = 9
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Mode = 0
Value = 0 'False
cBack = -2147483633
End
End
Attribute VB_Name = "frmFP"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim strFPName As String
Dim strFPName2 As String
Private Sub cmdAdd_Click()
freItem.Tag = "a"
freItem.caption = " 添加" & strFPName & " "
txtName.Text = ""
txtPhone.Text = ""
txtAddress.Text = ""
ShowFP True
End Sub
Private Sub cmdDel_Click()
On Error GoTo aaaa
Dim lst As ListView
If cmdFP(0).IfDraw Then
Set lst = List1
Else
Set lst = List2
End If
If MsgBox("注意：此操作会同时删除该" & strFPName & "的商品，商品销售，进货和进货计划记录。" & vbCrLf & vbCrLf & "确定要删除 " & lst.SelectedItem.Text & " 吗？", vbInformation + vbOKCancel + vbDefaultButton2) = vbCancel Then Exit Sub
cnMain.Execute "Delete From " & strFPName2 & " Where " & strFPName2 & "Name='" & lst.SelectedItem.Text & "'"
lst.ListItems.Remove lst.SelectedItem.Index
lst.SetFocus
Exit Sub
aaaa:
If Err.Number <> 91 Then MsgBox Err.Description, vbCritical
End Sub
Private Sub cmdEdit_Click()
On Error GoTo aaaa
freItem.Tag = "b"
Dim Item As ListItem
If cmdFP(0).IfDraw Then
Set Item = List1.SelectedItem
Else
Set Item = List2.SelectedItem
End If
txtName.Text = Item.Text
txtName.Tag = Item.Text
txtPhone.Text = Item.SubItems(1)
txtAddress.Text = Item.SubItems(2)
freItem.caption = " 修改" & strFPName & " "
ShowFP True
txtName.SetFocus
Exit Sub
aaaa:
End Sub
Private Sub cmdExit_Click()
ShowFP False
End Sub
Private Sub cmdFP_Click(Index As Integer)
If cmdFP(Index).IfDraw = True Then Exit Sub
cmdFP(Index).IfDraw = True
cmdFP(Index).BackColor = 14210516
cmdFP(1 - Index).IfDraw = False
cmdFP(1 - Index).BackColor = Me.BackColor
List1.Visible = cmdFP(0).IfDraw
List2.Visible = cmdFP(1).IfDraw
strFPName = IIf(Index = 0, "厂商", "供货商")
strFPName2 = IIf(Index = 0, "Factory", "Provide")
End Sub
Private Sub ShowFP(ByVal b As Boolean)
freItem.Visible = b
cmdDel.Enabled = Not b
cmdEdit.Enabled = Not b
cmdAdd.Enabled = Not b
cmdFP(0).Enabled = Not b
cmdFP(1).Enabled = Not b
If b Then
List1.Visible = False
List2.Visible = False
Else
List1.Visible = cmdFP(0).IfDraw
List2.Visible = cmdFP(1).IfDraw
End If
End Sub
Private Sub cmdOK_Click()
On Error GoTo aaaa
If txtName.Text = "" Then
MsgBox "必须填写" & strFPName & "名称。", vbInformation
txtName.SetFocus
Exit Sub
End If
Dim Item As ListItem, lst As ListView, j As Long
If cmdFP(0).IfDraw Then
Set lst = List1
j = 1
Else
Set lst = List2
j = 2
End If
If freItem.Tag = "a" Then
cnMain.Execute "insert " & strFPName2 & " values('" & txtName.Text & "','" & txtAddress.Text & "','" & txtPhone.Text & "')"
Set Item = lst.ListItems.Add(1, , txtName.Text, , j)
Item.SubItems(1) = txtPhone.Text
Item.SubItems(2) = txtAddress.Text
Else
cnMain.Execute "UPDATE " & strFPName2 & " SET " & strFPName2 & "Name='" & txtName.Text & "'," & strFPName2 & "Phone='" & txtPhone.Text & "'," & strFPName2 & "Address='" & txtAddress.Text & "' where " & strFPName2 & "Name='" & txtName.Tag & "'"
lst.SelectedItem.Text = txtName.Text
lst.SelectedItem.SubItems(1) = txtPhone.Text
lst.SelectedItem.SubItems(2) = txtAddress.Text
End If
cmdExit_Click
Exit Sub
aaaa:
MsgBox "操作失败，可能是该" & strFPName & "名称已经存在！", vbCritical
txtName.SetFocus
End Sub
Private Sub Form_Load()
On Error GoTo aaaa
Me.WindowState = 2
imgIcon.Picture = frmMain.cmdLeft(4).Picture
strFPName = "厂商"
strFPName2 = "Factory"
LoadFP
Exit Sub
aaaa:
MsgBox Err.Description, vbCritical
End Sub
Public Sub LoadFP()
Dim Item As ListItem
Dim rs As ADODB.Recordset, rs1 As ADODB.Recordset
Set rs = New ADODB.Recordset
Set rs1 = New ADODB.Recordset
rs.Open "Select * From Factory order by FactoryID desc", cnMain, 1, 1
If Not rs.EOF Then
Do Until rs.EOF
Set Item = List1.ListItems.Add(, , rs("FactoryName"), , 1)
Item.SubItems(1) = rs("FactoryPhone")
Item.SubItems(2) = rs("FactoryAddress")
rs.MoveNext
Loop
End If
rs1.Open "Select * From Provide order by ProvideID desc", cnMain, 1, 1
If Not rs1.EOF Then
Do Until rs1.EOF
Set Item = List2.ListItems.Add(, , rs1("ProvideName"), , 2)
Item.SubItems(1) = rs1("ProvidePhone")
Item.SubItems(2) = rs1("ProvideAddress")
rs1.MoveNext
Loop
End If
SetSB 2, "共 " & rs.RecordCount & " 条厂商记录, " & rs1.RecordCount & " 条供货商记录."
End Sub
Private Sub Form_Resize()
On Error Resume Next
List1.Width = Width / 15 - 104
List1.Height = Height / 15 - 114
List2.Width = Width / 15 - 104
List2.Height = Height / 15 - 114
PicTop.Width = Width / 15 - 16
Cls
Line (2, 2)-(Width / 15 - 14, Height / 15 - 29), 10921638, B
End Sub
Private Sub List1_DblClick()
On Error GoTo aaaa
Dim j As Long
j = List1.SelectedItem.Index
cmdEdit_Click
aaaa:
End Sub
Private Sub List1_KeyDown(KeyCode As Integer, Shift As Integer)
On Error GoTo aaaa
If KeyCode = vbKeyDelete Then
Dim j As Long
j = List1.SelectedItem.Index
cmdDel_Click
End If
aaaa:
End Sub
Private Sub List2_DblClick()
On Error GoTo aaaa
Dim j As Long
j = List2.SelectedItem.Index
cmdEdit_Click
aaaa:
End Sub
Private Sub List2_KeyDown(KeyCode As Integer, Shift As Integer)
On Error GoTo aaaa
If KeyCode = vbKeyDelete Then
Dim j As Long
j = List2.SelectedItem.Index
cmdDel_Click
End If
aaaa:
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -