frmsupplierinfo.frm

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

         Underline       =   -1  'True
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H00808000&
      Height          =   495
      Left            =   3360
      TabIndex        =   39
      Top             =   120
      Width           =   3255
   End
   Begin VB.Label Label24 
      Alignment       =   1  'Right Justify
      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          =   285
      Left            =   675
      TabIndex        =   38
      Top             =   5310
      Width           =   615
   End
   Begin VB.Label lblNowDate 
      Caption         =   "今天日期："
      BeginProperty DataFormat 
         Type            =   0
         Format          =   "gg yyyy""斥"" M""岿"" d""老"""
         HaveTrueFalseNull=   0
         FirstDayOfWeek  =   0
         FirstWeekOfYear =   0
         LCID            =   2052
         SubFormatType   =   0
      EndProperty
      ForeColor       =   &H00800000&
      Height          =   255
      Left            =   450
      TabIndex        =   37
      Top             =   360
      Width           =   2415
   End
   Begin VB.Label lable26 
      Alignment       =   1  'Right Justify
      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          =   315
      Left            =   6960
      TabIndex        =   36
      Top             =   4470
      Width           =   885
   End
   Begin VB.Label Label_A 
      Alignment       =   1  'Right Justify
      BackStyle       =   0  'Transparent
      Caption         =   "业务期限"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   10.5
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H000000C0&
      Height          =   285
      Left            =   3870
      TabIndex        =   35
      Top             =   1935
      Width           =   855
   End
   Begin VB.Label Label_Type 
      Alignment       =   1  'Right Justify
      BackColor       =   &H80000013&
      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          =   285
      Left            =   45
      TabIndex        =   34
      Top             =   2775
      Width           =   1245
   End
   Begin VB.Label Label27 
      Alignment       =   1  'Right Justify
      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          =   315
      Left            =   3720
      TabIndex        =   33
      Top             =   3165
      Width           =   1005
   End
   Begin VB.Label Label26 
      Alignment       =   1  'Right Justify
      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          =   255
      Left            =   15
      TabIndex        =   32
      Top             =   3630
      Width           =   1275
   End
End
Attribute VB_Name = "frmSupplierInfo"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
    
Private Sub cmdAdd_Click()
    SuppInfo_Add        '添加供应商信息
End Sub

Private Sub cmdAddType_Click()
    frmType.Show        '打开添加删除供货类别的窗体
End Sub

Private Sub cmdChange_Click()
    SuppInfo_Change     '修改供应商信息
End Sub

Private Sub cmdExit_Click()
    Unload Me
End Sub

Private Sub Initial_Add()
    Dim Rst As New ADODB.Recordset
    Dim strSQL As String
    
    With Combo_Supplevel    '添加项目
        .Clear
        .AddItem "1"
        .AddItem "2"
        .AddItem "3"
        .AddItem "4"
        .AddItem "5"
    End With
    With Combo_Banklevel    '添加项目
        .Clear
        .AddItem "A"
        .AddItem "B"
        .AddItem "C"
        .AddItem "D"
        .AddItem "E"
    End With
    strSQL = "select TypeID from tb_Type order by TypeID ASC"
    Rst.Open strSQL, CnnDatabase, adOpenDynamic, adLockReadOnly
    If Rst.BOF = True And Rst.EOF = True Then
        MsgBox "数据库中无任何可用的供货类别！", vbCritical, "错误！"
        Exit Sub
    End If
    Combo_Type.Clear
    Do While Rst.EOF = False    '给供货类别添加项目
        Combo_Type.AddItem Rst.Fields("TypeID").Value
        Rst.MoveNext
    Loop
    Me.txtSuppName.Text = ""    '清理控件内容
    Me.txtSuppID.Text = ""
    Me.txtSuppAddress.Text = ""
    Me.txtRegeditName.Text = ""
    Me.txtPostcode.Text = ""
    Me.txtEmail.Text = ""
    Me.txtWebSite.Text = ""
    Me.Combo_Type.ListIndex = -1
    Me.txtProperty.Text = ""
    Me.txtRegeditfund.Text = ""
    Me.txtRegeditMoney.Text = ""
    Me.txtRegeditcode.Text = ""
    Me.Combo_Supplevel.ListIndex = -1
    Me.txtTaxcode.Text = ""
    Me.txtBar.Text = ""
    Me.txtBankcode.Text = ""
    Me.txtBankname.Text = ""
    Me.Combo_Banklevel.ListIndex = -1
    Me.txtJurPerson.Text = ""
    Me.txtJurphone.Text = ""
    Me.txtJurFax.Text = ""
    Me.txtViaPerson.Text = ""
    Me.txtViaphone.Text = ""
    Me.txtViaFax.Text = ""
    Me.txtNote.Text = ""
    Me.lblNowDate.Caption = "今天日期： " & Format(Date, "yyyy年m月d日")
    Me.DT_RegeditDate.Value = Date  '设置时间控件的时间
    Me.DT_LimitStart = Date
    Me.DT_LimitEnd = Date
    Me.Height = 7350                '设置窗体外观
    Me.Width = 9930
End Sub

Private Sub cmdFresh_Click()
    If flagAddSupplier = True Then
        Initial_Add     '清除界面
    Else
        Initial_Change  '重置界面
    End If
End Sub

Private Sub Form_Load()
On Error GoTo ErrorExit
    If flagAddSupplier = True Then
        Me.Caption = "供应商信息 — [添加]"     '此窗体标题栏设置
        Me.cmdAdd.Visible = True                '按钮设置
        Me.cmdAdd.TabIndex = 28
        Me.cmdChange.Visible = False
        Me.cmdAdd.Left = 1740
        Me.cmdAdd.Top = 6405
        Me.cmdAdd.Default = True
        Initial_Add                             '初始化界面
        Exit Sub
    Else
        Me.Caption = "供应商信息 — [修改]"     '此窗体标题栏设置
        Me.cmdChange.Visible = True             '按钮设置
        Me.cmdChange.TabIndex = 28
        Me.cmdAdd.Visible = False
        Me.cmdChange.Left = 1740
        Me.cmdChange.Top = 6405
        Me.cmdChange.Default = True
        Initial_Change                          '初始化“修改”状态的窗体
        Exit Sub
    End If
ErrorExit:
    MsgBox Err.Description, vbCritical, Me.Caption
End Sub

Private Function SuppInfo_Add() As Boolean  '单击添加按钮，返回True说明添加信息成功，False不成功
    Dim Rst As New ADODB.Recordset          '临时记录集
    Dim strSQL As String    '记录执行的SQL语句
    Dim intRst As Integer   '记录集中的记录条数
    
On Error GoTo ErrorExit
    SuppInfo_Add = False    '默认添加新信息还不成功
    If CheckFaceIsOk = False Then   '引用函数判断是否可以进行添加信息
        Exit Function
    End If
    strSQL = "SELECT * FROM tb_Supplier WHERE SuppID ='S" & Me.txtSuppID.Text & "'"
    Rst.Open strSQL, CnnDatabase, adOpenDynamic, adLockOptimistic   '打开一个动态记录集
    intRst = 0
    Do While Rst.EOF = False
        intRst = intRst + 1
        Rst.MoveNext
    Loop
    If intRst > 0 Then          '在数据库种查找这个供应商代号，看是不是已经有了
        If intRst > 1 Then      '数据库中已经有了，且不只一个
            MsgBox "这个供应商代号已经在数据库中，且不唯一！", vbCritical, "数据库错误-"
        Else                    '数据库中已经有了一个。
            MsgBox "这个供应商代号已经在数据库中。", vbCritical, Me.Caption
        End If
        Me.txtSuppID.Text = ""
        Me.txtSuppID.SetFocus
        Exit Function
    End If
    Rst.AddNew                  '数据库中没有这个供应商代号，可以向里面新添了
    Rst.Fields("SuppName").Value = Me.txtSuppName.Text
    Rst.Fields("SuppID").Value = "S" & Me.txtSuppID.Text
    Rst.Fields("RegeditDate").Value = Me.DT_RegeditDate.Value
    Rst.Fields("SuppAddress").Value = Me.txtSuppAddress.Text
    Rst.Fields("RegeditName").Value = Me.txtRegeditName.Text
    Rst.Fields("LimitStart").Value = Me.DT_LimitStart.Value
    Rst.Fields("LimitEnd").Value = Me.DT_LimitEnd.Value
    Rst.Fields("Postcode").Value = Me.txtPostcode.Text
    Rst.Fields("Email").Value = Me.txtEmail.Text
    Rst.Fields("Website").Value = Me.txtWebSite.Text
    Rst.Fields("Type").Value = Me.Combo_Type.Text
    Rst.Fields("Property").Value = Me.txtProperty.Text
    Rst.Fields("Regeditfund").Value = Me.txtRegeditfund.Text
    Rst.Fields("RegeditMoney").Value = Me.txtRegeditMoney.Text
    Rst.Fields("Regeditcode").Value = Me.txtRegeditcode.Text
    Rst.Fields("Supplevel").Value = Me.Combo_Supplevel.Text
    Rst.Fields("Taxcode").Value = Me.txtTaxcode.Text
    Rst.Fields("Bar").Value = Me.txtBar.Text
    Rst.Fields("Bankcode").Value = Me.txtBankcode.Text
    Rst.Fields("Bankname").Value = Me.txtBankname.Text
    Rst.Fields("Banklevel").Value = Me.Combo_Banklevel.Text
    Rst.Fields("Jurperson").Value = Me.txtJurPerson.Text
    Rst.Fields("Jurphone").Value = Me.txtJurphone.Text
    Rst.Fields("Jurfax").Value = Me.txtJurFax.Text
    Rst.Fields("Viaperson").Value = Me.txtViaPerson.Text
    Rst.Fields("Viaphone").Value = Me.txtViaphone.Text
    Rst.Fields("Viafax").Value = Me.txtViaFax.Text
    If Me.txtNote.Text = "" Then
        Rst.Fields("Note").Value = "无"
    Else
        Rst.Fields("Note").Value = Me.txtNote.Text
    End If
    Rst.Update              '添加新信息结束
    MsgBox "添加新的供应商的信息成功！", vbInformation, "操作成功-"
    Set Rst = Nothing
    Initial_Add             '刷新界面
    SuppInfo_Add = False    '添加新信息成功了
    Exit Function
    
ErrorExit:
    MsgBox Err.Description, vbCritical, Me.Caption
End Function

Private Sub Initial_Change()
    Dim Rst As New ADODB.Recordset
    Dim strSQL As String

    With Combo_Supplevel    '添加项目
        .Clear
        .AddItem "1"
        .AddItem "2"
        .AddItem "3"
        .AddItem "4"
        .AddItem "5"
    End With
    With Combo_Banklevel    '添加项目
        .Clear
        .AddItem "A"
        .AddItem "B"
        .AddItem "C"
        .AddItem "D"
        .AddItem "E"
    End With
    strSQL = "select TypeID from tb_Type order by TypeID ASC"
    Rst.Open strSQL, CnnDatabase, adOpenDynamic, adLockReadOnly
    If Rst.BOF = True And Rst.EOF = True Then
        MsgBox "数据库中无任何可用的供货类别！", vbCritical, "错误！"
        Exit Sub
    End If
    Combo_Type.Clear
    Do While Rst.EOF = False            '给供货类别添加项目
        Combo_Type.AddItem Rst.Fields("TypeID").Value
        Rst.MoveNext
    Loop
    Set Rst = Nothing                   '清除记录集，释放内存
    strSQL = "select * from tb_Supplier where SuppID ='" & Module1.strSuppID & "'"
    Rst.Open strSQL, CnnDatabase, adOpenDynamic, adLockReadOnly
    Me.txtSuppName.Text = Rst.Fields("SuppName").Value      '给界面上的控件赋值
    Me.txtSuppID.Text = Right(Rst!SuppID, Len(Rst!SuppID) - 1)
    Me.DT_RegeditDate.Value = Rst.Fields("RegeditDate").Value
    Me.txtSuppAddress.Text = Rst.Fields("SuppAddress").Value
    Me.txtRegeditName.Text = Rst.Fields("RegeditName").Value