form2.frm

vbsql做的销售管理课程设计样本不完全仅为范例

VERSION 5.00
Begin VB.Form form2 
   BorderStyle     =   3  'Fixed Dialog
   Caption         =   "信息"
   ClientHeight    =   4725
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   9345
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   4725
   ScaleWidth      =   9345
   ShowInTaskbar   =   0   'False
   StartUpPosition =   1  '所有者中心
   Begin VB.Frame Frame1 
      Caption         =   "销售商信息"
      Height          =   3015
      Left            =   600
      TabIndex        =   5
      Top             =   360
      Width           =   7695
      Begin VB.TextBox txtItem 
         Height          =   375
         Index           =   4
         Left            =   4920
         MaxLength       =   10
         TabIndex        =   14
         Top             =   1440
         Width           =   2175
      End
      Begin VB.ComboBox Combo1 
         Height          =   300
         Left            =   1440
         TabIndex        =   13
         Top             =   480
         Width           =   2055
      End
      Begin VB.TextBox txtItem 
         Height          =   270
         Index           =   3
         Left            =   1440
         MaxLength       =   10
         TabIndex        =   3
         Top             =   1440
         Width           =   2055
      End
      Begin VB.TextBox txtItem 
         Height          =   375
         Index           =   2
         Left            =   4920
         MaxLength       =   20
         TabIndex        =   2
         Top             =   840
         Width           =   2172
      End
      Begin VB.TextBox txtItem 
         Height          =   390
         Index           =   1
         Left            =   1440
         MaxLength       =   20
         TabIndex        =   1
         Top             =   840
         Width           =   2055
      End
      Begin VB.TextBox txtItem 
         Height          =   375
         Index           =   0
         Left            =   4920
         MaxLength       =   20
         TabIndex        =   0
         Top             =   360
         Width           =   2175
      End
      Begin VB.Label Label2 
         Caption         =   "备    注"
         Height          =   255
         Index           =   5
         Left            =   3720
         TabIndex        =   12
         Top             =   1440
         Width           =   975
      End
      Begin VB.Label Label2 
         Caption         =   "电    话"
         Height          =   255
         Index           =   4
         Left            =   240
         TabIndex        =   11
         Top             =   1440
         Width           =   855
      End
      Begin VB.Label Label2 
         Caption         =   "负 责 人"
         Height          =   255
         Index           =   3
         Left            =   3720
         TabIndex        =   10
         Top             =   960
         Width           =   975
      End
      Begin VB.Label Label2 
         Caption         =   "销售商名称 "
         Height          =   255
         Index           =   1
         Left            =   3720
         TabIndex        =   9
         Top             =   480
         Width           =   1095
      End
      Begin VB.Label Label2 
         Caption         =   "销售商编号"
         Height          =   255
         Index           =   0
         Left            =   120
         TabIndex        =   8
         Top             =   480
         Width           =   1095
      End
      Begin VB.Label Label2 
         Caption         =   "地    区"
         Height          =   255
         Index           =   2
         Left            =   240
         TabIndex        =   7
         Top             =   960
         Width           =   855
      End
   End
   Begin VB.CommandButton cmdExit 
      Caption         =   "返回 (&X)"
      Height          =   375
      Left            =   4440
      TabIndex        =   6
      Top             =   3840
      Width           =   1215
   End
   Begin VB.CommandButton cmd 
      Caption         =   "保存 (&S)"
      Height          =   375
      Left            =   3000
      TabIndex        =   4
      Top             =   3840
      Width           =   1215
   End
End
Attribute VB_Name = "form2"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False


Private Sub cmd_Click()
 Dim iCount As Integer
    Dim sMeg As String
    Dim mrcc As ADODB.Recordset
    Dim MsgText As String
    Dim xsbh, xsmc, dq, fzr, dh, mz As String
    Dim cnn As ADODB.Connection
    Dim cmdupdate  As New ADODB.Command
    Dim cmddele As New ADODB.Command
    
 Select Case flagadd

 Case 1 '添加
        
          If Trim(Combo1.Text & " ") = "" Then
           sMeg = "销售商编号"
           End If
    For iCount = 0 To 4
        If Trim(txtItem(iCount) & " ") = "" Then
         Select Case iCount
               Case 0
                    sMeg = "销售商名称"
              Case 1
                    sMeg = "地区"
               Case 2
                    sMeg = "负责人"
               Case 3
                    sMeg = "电话"
                 Case 4
                    sMeg = "备注"
            End Select
          sMeg = sMeg & "不能为空！"
           MsgBox sMeg, vbOKOnly + vbExclamation, "警告"
          txtItem(iCount).SetFocus
          Exit Sub
       End If
   Next iCount
       xsbh = Combo1.Text
   Combo1.AddItem Trim(xsbh)
     xsmc = txtItem(0).Text
      dq = txtItem(1).Text
      fzr = txtItem(2).Text
      dh = txtItem(3).Text
      mz = txtItem(4).Text
      txtSQL = "select * from xss where xsbh='" & Trim(Combo1.Text) & "'"
    Set mrc = ExecuteSQL(txtSQL)
    If mrc.EOF = False Then
      MsgBox "此销售商的编号已存在！", vbOKOnly + vbExclamation, "警告"
      Combo1.SetFocus
         mrc.Close
         Else
         Set cnn = New ADODB.Connection
   cnn.Open ConnectString
  cnn.Execute "exec xss_insert '" & xsbh & "','" & xsmc & "','" & dq & "','" & fzr & "','" & dh & "','" & mz & "'"
   cnn.Close
  
        MsgBox "数据已保存！", vbOKOnly + vbExclamation, "提示"
     Combo1.Text = ""
       For iCount = 0 To 4
        txtItem(iCount).Text = ""
        Next iCount
End If
Case 2 '修改
     xsbh = Combo1.Text
     xsmc = txtItem(0).Text
      dq = txtItem(1).Text
      fzr = txtItem(2).Text
      dh = txtItem(3).Text
      mz = txtItem(4).Text
     Set cnn = New ADODB.Connection
    cnn.Open ConnectString
    Set cmdupdate.ActiveConnection = cnn
  cmdupdate.CommandText = "xss_update"
  cmdupdate.CommandType = adCmdStoredProc
 cmdupdate.Parameters.Append cmdupdate.CreateParameter("xsbh0", adChar, adParamInput, 6, xsbh)
 cmdupdate.Parameters.Append cmdupdate.CreateParameter("xsmc0", adChar, adParamInput, 30, xsmc)
 cmdupdate.Parameters.Append cmdupdate.CreateParameter("dq0", adChar, adParamInput, 10, dq)
   cmdupdate.Parameters.Append cmdupdate.CreateParameter("fzr0", adChar, adParamInput, 8, fzr)
    cmdupdate.Parameters.Append cmdupdate.CreateParameter("dh0", adChar, adParamInput, 12, dh)
     cmdupdate.Parameters.Append cmdupdate.CreateParameter("mz0", adChar, adParamInput, 50, mz)
 cmdupdate.Parameters.Append cmdupdate.CreateParameter("flag", adInteger, adParamOutput)
  cmdupdate.Execute
          If cmdupdate("flag") = 1 Then
     MsgBox "数据已更新！", vbOKOnly + vbExclamation, "提示"
     Else
      MsgBox "数据更新不成功！", vbOKOnly + vbExclamation, "提示"
       cnn.Close
       End If
Case 3 '删除
   xsbh = Combo1.Text
   Set cnn = New ADODB.Connection
  cnn.Open ConnectString
  Set cmddele.ActiveConnection = cnn
  cmddele.CommandText = "xss_delete"
  cmddele.CommandType = adCmdStoredProc
  cmddele.Parameters.Append cmddele.CreateParameter("xsbh0", adChar, adParamInput, 16, xsbh)
  cmddele.Parameters.Append cmddele.CreateParameter("flag", adInteger, adParamOutput)
 cmddele.Execute
      If cmddele("flag") = 1 Then
  MsgBox "记录已被删除！", vbOKOnly + vbExclamation, "提示"
  For iCount = 0 To Combo1.ListCount - 1
  If Combo1.List(iCount) = Combo1.Text And Combo1.Text <> "" Then
   Combo1.RemoveItem iCount
 Combo1.Text = ""
  End If
 Next iCount
    For iCount = 0 To 4
    txtItem(iCount).Text = ""
          Next iCount
  End If
 cnn.Close
    
       End Select
End Sub

Private Sub cmdExit_Click()
 Unload Me
End Sub

Private Sub Combo1_Click()
Dim xsbh, MsgText As String
Dim i As Integer
  xsbh = Combo1.Text
        txtSQL = "select *  from xss where xsbh='" & xsbh & "'"
        Set mrc = ExecuteSQL(txtSQL)
                  If Not mrc.EOF Then
                  For i = 0 To 4
                  If Not IsNull(mrc.Fields(i + 1)) Then
                        txtItem(i).Text = mrc.Fields(i + 1)
                     Else
                     txtItem(i).Text = ""
                     End If
                    Next i
                  End If
             mrc.Close

End Sub

Private Sub Combo1_KeyPress(KeyAscii As Integer)
Dim MsgText As String
If KeyAscii = 13 And flagadd = 1 Then  '添加书籍操作
       txtSQL = "select * from xss where xsbh='" & Trim(Combo1.Text) & "'"
    Set mrc = ExecuteSQL(txtSQL)
    If mrc.EOF = False Then
      MsgBox "销售商的编号已存在！", vbOKOnly + vbExclamation, "警告"
      Combo1.SetFocus
         mrc.Close
         Else
         txtItem(0).SetFocus
     End If
     End If
End Sub

Private Sub Form_Activate()
Dim MsgText As String
Dim ftag As Integer
        txtSQL = "select *  from xss"
        Set mrc = ExecuteSQL(txtSQL)
        ftag = 0
               
                   Do While Not mrc.EOF
                    Combo1.AddItem Trim(mrc.Fields(0))
                    If ftag = 0 Then
                   ftag = 1
                      Combo1.Text = mrc.Fields(0)
                     txtItem(0).Text = mrc.Fields(1)
                     txtItem(1).Text = mrc.Fields(2)
                     txtItem(2).Text = mrc.Fields(3)
                     txtItem(3).Text = mrc.Fields(4)
                     End If
                      mrc.MoveNext
                Loop
             
             mrc.Close
     Combo1.SetFocus

End Sub

Private Sub Form_Load()
Me.Caption = "销售商信息"

   Select Case flagadd
 Case 1
       Me.Caption = Me.Caption & "添加"
        cmd.Caption = "保存 (&S)"
       
 Case 2
        Me.Caption = Me.Caption & "修改"
          cmd.Caption = "更新 (&U)"
      
   Case 3
       Me.Caption = Me.Caption & "删除"
              cmd.Caption = "删除 (&D)"
         
  Case 4
       Me.Caption = Me.Caption & "查询"
              
       End Select
End Sub

Private Sub txtItem_KeyDown(Index As Integer, KeyCode As Integer, Shift As Integer)
Select Case Index
        Case 0
        If KeyCode = 13 Then
        txtItem(1).SetFocus
        End If
        Case 1
        If KeyCode = 13 Then
        txtItem(2).SetFocus
        End If
        Case 2
        If KeyCode = 13 Then
        txtItem(3).SetFocus
        End If
        Case 3
        If KeyCode = 13 Then
        txtItem(4).SetFocus
        End If
               
        End Select
End Sub