frmfp.frm

超市销售管理系统 4) 文档里面有完整的需求说明书

         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 SuperMarket.XPButton cmdDel 
      Height          =   345
      Left            =   3600
      TabIndex        =   15
      Top             =   660
      Width           =   1095
      _extentx        =   1931
      _extenty        =   609
      caption         =   "删除(&D)"
      capalign        =   2
      backstyle       =   2
      font            =   "frmFP.frx":1374
      mode            =   0
      value           =   0
      cback           =   -2147483633
   End
   Begin SuperMarket.XPButton cmdEdit 
      Height          =   345
      Left            =   2400
      TabIndex        =   16
      Top             =   660
      Width           =   1095
      _extentx        =   1931
      _extenty        =   609
      caption         =   "修改(&E)"
      capalign        =   2
      backstyle       =   2
      font            =   "frmFP.frx":1398
      mode            =   0
      value           =   0
      cback           =   -2147483633
   End
   Begin SuperMarket.XPButton cmdAdd 
      Height          =   345
      Left            =   1200
      TabIndex        =   17
      Top             =   660
      Width           =   1095
      _extentx        =   1931
      _extenty        =   609
      caption         =   "添加(&A)"
      capalign        =   2
      backstyle       =   2
      font            =   "frmFP.frx":13BC
      mode            =   0
      value           =   0
      cback           =   -2147483633
   End
End
Attribute VB_Name = "frmFP"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'超市销售系统
'程序开发：lc_mtt
'CSDN博客：http://blog.csdn.net/lc_mtt/
'个人主页：http://www.3lsoft.com
'邮箱：[e-mail]
'注：此代码禁止用于商业用途。有修改者发我一份，谢谢！
'---------------- 开源世界，你我更进步 ----------------


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