frmmdimain.frm

客户关系管理系统(打包+源程序)是数据库系统开发项目方案精解系列丛书VB数据库管理中附带CD中的程序

VERSION 5.00
Begin VB.MDIForm frmMDIMain 
   BackColor       =   &H00FFC0C0&
   Caption         =   "供应商/客户关系管理"
   ClientHeight    =   4995
   ClientLeft      =   165
   ClientTop       =   735
   ClientWidth     =   6675
   LinkTopic       =   "MDIForm1"
   LockControls    =   -1  'True
   StartUpPosition =   3  '窗口缺省
   WindowState     =   2  'Maximized
   Begin VB.Menu Supplier 
      Caption         =   "供应商信息"
      Begin VB.Menu SuppAdd 
         Caption         =   "建立新供应商"
      End
      Begin VB.Menu SuppChange 
         Caption         =   "修改已有供应商"
      End
      Begin VB.Menu SuppCheck 
         Caption         =   "供应商查询"
      End
      Begin VB.Menu SuppDel 
         Caption         =   "记录删除"
      End
   End
   Begin VB.Menu Customer 
      Caption         =   "客户信息"
      Begin VB.Menu CustAdd 
         Caption         =   "建立新客户"
      End
      Begin VB.Menu CustChange 
         Caption         =   "修改已有客户"
      End
      Begin VB.Menu CustCheck 
         Caption         =   "客户查询"
      End
      Begin VB.Menu CustDel 
         Caption         =   "记录删除"
      End
   End
   Begin VB.Menu Server 
      Caption         =   "客户服务"
      Begin VB.Menu QuestInput 
         Caption         =   "问题信息录入"
      End
      Begin VB.Menu QuestCheck 
         Caption         =   "问题信息查询"
      End
      Begin VB.Menu QuestChange 
         Caption         =   "问题信息修改"
      End
      Begin VB.Menu QuestDel 
         Caption         =   "问题信息删除"
      End
   End
   Begin VB.Menu system 
      Caption         =   "系统设置"
      Begin VB.Menu AddOne 
         Caption         =   "增删管理员"
      End
      Begin VB.Menu ChangePwd 
         Caption         =   "更改登录密码"
      End
      Begin VB.Menu aaa 
         Caption         =   "-"
      End
      Begin VB.Menu ReLogin 
         Caption         =   "注销"
      End
      Begin VB.Menu Logout 
         Caption         =   "退出系统"
      End
   End
   Begin VB.Menu About 
      Caption         =   "关于"
   End
End
Attribute VB_Name = "frmMDIMain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
    Dim ToExit As Boolean           '区分注销和退出两种状态

Private Sub About_Click()
    frmAbout.Show
End Sub

Private Sub CustAdd_Click()
    flagAddCustomer = True          '设置标志：建立客户信息
    frmCustomerInfo.Show            '打开添加客户信息窗体
End Sub

Private Sub CustChange_Click()
    Dim Rst As New ADODB.Recordset
    Dim strSQL As String
    
    Module1.strCustID = InputBox("请输入要查询的客户代码：（以C开头）", _
        "客户信息修改")           '输入要修改的客户代码
    If Module1.strCustID = "" Then          '没有输入客户代码
        Exit Sub
    End If
    strSQL = "select * from tb_Customer where CustID ='" & Module1.strCustID & "'"
    Rst.Open strSQL, CnnDatabase, adOpenStatic, adLockReadOnly  '静态的打开一个记录集
    If Rst.RecordCount = 0 Then     '没有记录
        MsgBox "此客户代码不在数据库中。", vbCritical, "错误！"
        Exit Sub
    End If
    If Rst.RecordCount > 1 Then     '有重复记录
        MsgBox "此客户代码在数据库中出现重复性错误！", vbCritical, "错误！"
        Exit Sub
    End If
    flagAddCustomer = False         '建立标志：修改客户信息
    frmCustomerInfo.Show            '打开更改客户信息窗体
End Sub

Private Sub CustCheck_Click()
    frmCustCheck.Show               '打开查询客户信息窗体
End Sub

Private Sub CustDel_Click()
    frmCustDel.Show                 '打开删除客户信息的窗体
End Sub

Private Sub Logout_Click()
    ToExit = True
    Unload Me
End Sub

Private Sub MDIForm_Load()
    Me.Caption = Me.Caption & " — [ " & strNowUser & " ]"
    ToExit = True
    Me.ReLogin.Caption = Me.ReLogin.Caption & " — [ " & strNowUser & " ]"
    Module1.strSuppID = ""
End Sub

Private Sub MDIForm_QueryUnload(Cancel As Integer, UnloadMode As Integer)
    Dim RetVal          '用于记录MsgBox的返回值
    Dim str As String
    Dim i As Integer
    
On Error Resume Next    '错误处理
    If ToExit = True Then
        str = "您确定要退出系统吗？"
    Else
        str = "您确定要注销吗？"
    End If
    
    RetVal = MsgBox(str, vbQuestion + vbYesNo, Me.Caption)
    Select Case RetVal
    Case vbYes
        Cancel = False
        For i = 0 To Forms.Count - 1  '退出所有打开着的窗体
            Unload Forms(i)
        Next i
        Set CnnDatabase = Nothing     '关闭数据库
        If ToExit = False Then        '如果是注销，就重新加载窗体
            frmLogin.Show
        End If
    Case vbNo
        Cancel = True
        ToExit = True
    End Select
End Sub

Private Sub QuestChange_Click()
    frmServerChange.Show            '打开客户服务信息更改的窗体
End Sub

Private Sub QuestCheck_Click()
    frmServerCheck.Show             '打开客户服务信息查询窗体
End Sub

Private Sub QuestDel_Click()
    frmServerDel.Show               '打开问题信息删除窗体
End Sub

Private Sub QuestInput_Click()
    frmServerInput.Show             '打开客户服务信息录入窗体
End Sub

Private Sub ReLogin_Click()
    ToExit = False
    Unload Me
End Sub

Private Sub SuppAdd_Click()
    flagAddSupplier = True          '新建供应商信息的标志
    frmSupplierInfo.Show            '打开添加供应商信息窗体
End Sub

Private Sub SuppChange_Click()
    Dim Rst As New ADODB.Recordset
    Dim strSQL As String
    
    Module1.strSuppID = InputBox("请输入要查询的供应商代码：（以S开头）", _
        "供应商信息修改")           '输入要修改的供应商代码
    If Module1.strSuppID = "" Then          '没有输入供应商代码
        Exit Sub
    End If
    strSQL = "select * from tb_Supplier where SuppID ='" & Module1.strSuppID & "'"
    Rst.Open strSQL, CnnDatabase, adOpenStatic, adLockReadOnly  '静态的打开一个记录集
    If Rst.RecordCount = 0 Then     '没有记录
        MsgBox "此供应商代码不在数据库中。", vbCritical, "错误！"
        Exit Sub
    End If
    If Rst.RecordCount > 1 Then     '有重复记录
        MsgBox "此供应商代码在数据库中出现重复性错误！", vbCritical, "错误！"
        Exit Sub
    End If
    flagAddSupplier = False         '修改供应商信息的标志
    frmSupplierInfo.Show            '打开更改供应商信息窗体
End Sub

Private Sub SuppCheck_Click()
    frmSuppCheck.Show               '打开查询供应商信息窗体
End Sub

Private Sub SuppDel_Click()
    frmSuppDel.Show                 '打开删除供应商信息窗体
End Sub