main_jbxx_kh.frm

基于VB + SQL Server 的商品进销管理,是学习VB数据库编程的重要参考

            Height          =   255
            Left            =   195
            TabIndex        =   31
            Top             =   2685
            Width           =   1185
         End
         Begin VB.Label Label4 
            BackStyle       =   0  'Transparent
            Caption         =   "传真:                   联系人电话:"
            BeginProperty Font 
               Name            =   "宋体"
               Size            =   10.5
               Charset         =   134
               Weight          =   400
               Underline       =   0   'False
               Italic          =   0   'False
               Strikethrough   =   0   'False
            EndProperty
            Height          =   690
            Left            =   5565
            TabIndex        =   30
            Top             =   2340
            Width           =   1260
         End
         Begin VB.Label Label3 
            Caption         =   "邮政编码:"
            BeginProperty Font 
               Name            =   "宋体"
               Size            =   10.5
               Charset         =   134
               Weight          =   400
               Underline       =   0   'False
               Italic          =   0   'False
               Strikethrough   =   0   'False
            EndProperty
            Height          =   270
            Left            =   5580
            TabIndex        =   29
            Top             =   1905
            Width           =   1020
         End
         Begin VB.Label Label1 
            Caption         =   "客户编号:             客户全称:             客户简称:             客户地址:             所属地区:             电话: "
            BeginProperty Font 
               Name            =   "宋体"
               Size            =   10.5
               Charset         =   134
               Weight          =   400
               Underline       =   0   'False
               Italic          =   0   'False
               Strikethrough   =   0   'False
            EndProperty
            Height          =   2400
            Left            =   195
            TabIndex        =   28
            Top             =   210
            Width           =   1200
         End
      End
   End
   Begin VB.Frame Frame2 
      BackColor       =   &H00C0C0C0&
      Height          =   645
      Left            =   60
      TabIndex        =   0
      Top             =   5475
      Width           =   9105
      Begin VB.CommandButton CmdMD 
         BackColor       =   &H00FFC0C0&
         BeginProperty Font 
            Name            =   "宋体"
            Size            =   12
            Charset         =   134
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   360
         Index           =   3
         Left            =   2670
         Picture         =   "main_jbxx_kh.frx":005D
         Style           =   1  'Graphical
         TabIndex        =   38
         Top             =   195
         Width           =   800
      End
      Begin VB.CommandButton CmdMD 
         BackColor       =   &H00FFC0C0&
         BeginProperty Font 
            Name            =   "宋体"
            Size            =   12
            Charset         =   134
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   360
         Index           =   2
         Left            =   1860
         Picture         =   "main_jbxx_kh.frx":160A
         Style           =   1  'Graphical
         TabIndex        =   37
         Top             =   195
         Width           =   800
      End
      Begin VB.CommandButton CmdMD 
         BackColor       =   &H00FFC0C0&
         BeginProperty Font 
            Name            =   "宋体"
            Size            =   12
            Charset         =   134
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   360
         Index           =   1
         Left            =   1065
         Picture         =   "main_jbxx_kh.frx":2B0E
         Style           =   1  'Graphical
         TabIndex        =   36
         Top             =   195
         Width           =   800
      End
      Begin VB.CommandButton CmdMD 
         BackColor       =   &H00FFC0C0&
         BeginProperty Font 
            Name            =   "宋体"
            Size            =   12
            Charset         =   134
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   360
         Index           =   0
         Left            =   270
         Picture         =   "main_jbxx_kh.frx":4040
         Style           =   1  'Graphical
         TabIndex        =   35
         Top             =   195
         Width           =   800
      End
      Begin VB.CommandButton CmdModify 
         BackColor       =   &H00C0C0C0&
         Caption         =   "[M]修改"
         Height          =   360
         Left            =   5025
         Style           =   1  'Graphical
         TabIndex        =   5
         Top             =   195
         Width           =   800
      End
      Begin VB.CommandButton CmdExit 
         BackColor       =   &H00C0C0C0&
         Caption         =   "[X]退出"
         Height          =   360
         Left            =   8205
         Style           =   1  'Graphical
         TabIndex        =   4
         Top             =   195
         Width           =   800
      End
      Begin VB.CommandButton CmdEsc 
         BackColor       =   &H00C0C0C0&
         Caption         =   "[E]取消"
         Height          =   360
         Left            =   7410
         Style           =   1  'Graphical
         TabIndex        =   3
         Top             =   195
         Width           =   800
      End
      Begin VB.CommandButton CmdDelete 
         BackColor       =   &H00C0C0C0&
         Caption         =   "[D]删除"
         Height          =   360
         Left            =   5820
         Style           =   1  'Graphical
         TabIndex        =   2
         Top             =   195
         Width           =   800
      End
      Begin VB.CommandButton CmdAdd 
         BackColor       =   &H00C0C0C0&
         Caption         =   "[A]添加"
         Height          =   360
         Left            =   4215
         Style           =   1  'Graphical
         TabIndex        =   1
         Top             =   195
         Width           =   800
      End
      Begin VB.CommandButton CmdSave 
         BackColor       =   &H00C0C0C0&
         Caption         =   "[S]保存"
         Enabled         =   0   'False
         Height          =   360
         Left            =   6615
         Style           =   1  'Graphical
         TabIndex        =   10
         Top             =   195
         Width           =   800
      End
   End
End
Attribute VB_Name = "main_jbxx_kh"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim i As Integer     '定义整型变量
Dim rs1 As New ADODB.Recordset     '定义数据集对象
Public Sub view_data()     '定义显示数据的函数
  For i = 0 To 13
      If Adodc1.Recordset.RecordCount > 0 Then kh(i).Text = Adodc1.Recordset.Fields(i) Else kh(i).Text = ""
  Next i
End Sub
Private Sub Form_Activate()
  '向combo1中添加查询项目列表
  Combo1.AddItem ("客户编号")
  Combo1.AddItem ("客户全称")
  Combo1.ListIndex = 1
  '打开客户信息表
  rs1.Open "select * from 客户信息表 order by 客户编号", Cnn, adOpenKeyset, adLockOptimistic
  If rs1.RecordCount > 0 Then
   For i = 0 To 13
    If rs1.Fields(i) <> "" Then kh(i).Text = rs1.Fields(i)
   Next i
  End If
  rs1.Close     '关闭数据集对象
End Sub
Private Sub Form_Unload(Cancel As Integer)
  frm_main.Enabled = True
End Sub
Private Sub kh_KeyDown(Index As Integer, KeyCode As Integer, Shift As Integer)
  If KeyCode = vbKeyReturn And Index < 13 Then kh(Index + 1).SetFocus '回车获得焦点
  If KeyCode = vbKeyReturn And Index = 13 Then CmdSave.SetFocus
  If KeyCode = vbKeyUp And Index > 1 Then kh(Index - 1).SetFocus
End Sub
Private Sub SSTab1_Click(PreviousTab As Integer)
  If Adodc1.Recordset.RecordCount > 0 Then
     If SSTab1.Tab = 1 And CmdAdd.Enabled = False Then
        MsgBox ("您正在处理数据,请取消数据处理,在执行本操作!")
        SSTab1.Tab = 0
     End If
  End If
End Sub
Private Sub CmdFind_Click()     '查询客户信息
  Adodc1.RecordSource = "select * from 客户信息表 where (客户信息表." & Combo1.Text & " like + '" + Text1.Text + "'+'%')"
  Adodc1.Refresh
  Call view_data     '调用函数
  SSTab1.Tab = 1
End Sub
Private Sub CmdMD_Click(Index As Integer)
  Select Case Index
  Case Is = 0     '移到第一条记录
   If Not Adodc1.Recordset.BOF Then Adodc1.Recordset.MoveFirst
  Case Is = 1     '移到上一条记录
   If Adodc1.Recordset.RecordCount > 0 Then
    If Adodc1.Recordset.BOF = False Then Adodc1.Recordset.MovePrevious
    If Adodc1.Recordset.BOF = True Then Adodc1.Recordset.MoveFirst
   End If
  Case Is = 2     '移到下一条记录
   If Adodc1.Recordset.RecordCount > 0 Then
    If Adodc1.Recordset.EOF = False Then Adodc1.Recordset.MoveNext
    If Adodc1.Recordset.EOF = True Then Adodc1.Recordset.MoveLast
   End If
  Case Is = 3     '移到最后一条记录
    If Adodc1.Recordset.EOF = False Then Adodc1.Recordset.MoveLast
  End Select
  Call view_data     '调用函数
End Sub
Private Sub CmdAdd_Click()
  '自动创建客户编号
  Dim bh As Integer
  rs1.Open "select * from 客户信息表 order by 客户编号", Cnn, adOpenKeyset, adLockOptimistic
  If rs1.RecordCount > 0 Then
  If Not rs1.EOF Then rs1.MoveLast
  If rs1.Fields("客户编号") <> "" Then
     bh = Right(Trim(rs1.Fields("客户编号")), 4) + 1
     kh(0).Text = "kh" & Format(bh, "0000")
  End If
  Else
  kh(0).Text = "kh0001"
  End If
  rs1.Close     '关闭数据集对象
  For i = 1 To 13
   kh(i).Enabled = True
   kh(i).Text = ""
  Next i
  '设置控件状态
  CmdSave.Enabled = True: CmdEsc.Enabled = True: CmdAdd.Enabled = False
  CmdModify.Enabled = False: CmdDelete.Enabled = False
  For i = 0 To 3
   CmdMD(i).Enabled = False
  Next i
  SSTab1.Tab = 0
  kh(1).SetFocus
End Sub
Private Sub CmdModify_Click()     '允许用户修改
  If Adodc1.Recordset.RecordCount > 0 Then
     For i = 0 To 13
         kh(i).Enabled = True
     Next i
     CmdSave.Enabled = True: CmdEsc.Enabled = True: CmdAdd.Enabled = False
     CmdModify.Enabled = False: CmdDelete.Enabled = False
     For i = 0 To 3
         CmdMD(i).Enabled = False
     Next i
  Else
     MsgBox ("没有要修改的数据!")
  End If
End Sub
Private Sub CmdDelete_Click()     '删除客户信息
  If Adodc1.Recordset.RecordCount > 0 Then
     a = MsgBox("您确实要删除这条数据吗?", vbYesNo)
     If a = vbYes Then
        '打开错误处理程序
        On Error GoTo ErrorHandler
        Adodc1.Recordset.Delete
        Adodc1.Refresh
        For i = 0 To 13
            If Adodc1.Recordset.Fields(i) <> "" Then kh(i).Text = Adodc1.Recordset.Fields(i)
        Next i
        CmdSave.Enabled = False: CmdEsc.Enabled = False: CmdAdd.Enabled = True
        CmdModify.Enabled = True: CmdDelete.Enabled = True
        For i = 0 To 3
            CmdMD(i).Enabled = True
        Next i
     End If
     Exit Sub     '退出程序，以避免进入错误处理程序
ErrorHandler:     '错误处理程序
     If Err.Number = -2147217900 Then
        MsgBox "此客户与商家已存在往来关系，系统不允许删除！"
        Resume Next     '从紧随产生错误的语句的下个语句恢复运行
     End If
  End If
End Sub
Private Sub CmdSave_Click()     '保存客户信息
  rs1.Open "select * from 客户信息表 where 客户编号='" & Trim(kh(0).Text) & "'order by 客户编号", Cnn, adOpenKeyset, adLockOptimistic
  If rs1.RecordCount > 0 Then
   Dim a As String
   a = MsgBox("您确实要修改这条数据吗?", vbYesNo)
   If a = vbYes Then
   For i = 1 To 13
       If kh(1).Text <> "" Then rs1.Fields(i) = Trim(kh(i).Text)
       kh(i).Enabled = False
   Next i
   rs1.Update
   Adodc1.Refresh
   End If
  Else
   If kh(1).Text <> "" And kh(2).Text <> "" Then
     '添加客户信息
     rs1.AddNew
     For i = 0 To 13
         rs1.Fields(i) = Trim(kh(i).Text)
         kh(i).Enabled = False
     Next i
     rs1.Update     '更新数据库
     Adodc1.Refresh
   Else
     MsgBox "请填写完整的信息"
   End If
  End If
  rs1.Close     '关闭数据集对象
  '设置控件状态
  CmdSave.Enabled = False: CmdEsc.Enabled = False: CmdAdd.Enabled = True
  CmdModify.Enabled = True: CmdDelete.Enabled = True
  For i = 0 To 3
   CmdMD(i).Enabled = True
  Next i
End Sub
Private Sub CmdEsc_Click()     '取消操作
  rs1.Open "select * from 客户信息表 order by 客户编号", Cnn, adOpenKeyset, adLockOptimistic
  If rs1.RecordCount > 0 Then
     For i = 0 To 13
         If rs1.Fields(i) <> "" Then kh(i).Text = rs1.Fields(i)     '赋值给kh(i)
         kh(i).Enabled = False
     Next i
  End If
  rs1.Close
  '设置控件有效或无效
  CmdSave.Enabled = False: CmdEsc.Enabled = False: CmdAdd.Enabled = True
  CmdModify.Enabled = True: CmdDelete.Enabled = True
  For i = 0 To 3
      CmdMD(i).Enabled = True
  Next i
End Sub
Private Sub CmdExit_Click()
  Call CmdEnd(Me)
End Sub