frmsuppdel.frm

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

VERSION 5.00
Object = "{86CF1D34-0C5F-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCT2.OCX"
Object = "{5E9E78A0-531B-11CF-91F6-C2863C385E30}#1.0#0"; "MSFLXGRD.OCX"
Begin VB.Form frmSuppDel 
   Caption         =   "供应商信息 - [删除]"
   ClientHeight    =   4950
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   9255
   LinkTopic       =   "Form3"
   LockControls    =   -1  'True
   ScaleHeight     =   4950
   ScaleWidth      =   9255
   StartUpPosition =   3  '窗口缺省
   Begin VB.Frame Frame1 
      Caption         =   "删除条件（请小心使用！）"
      BeginProperty Font 
         Name            =   "隶书"
         Size            =   14.25
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   -1  'True
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H00C000C0&
      Height          =   1695
      Left            =   240
      TabIndex        =   3
      Top             =   120
      Width           =   6735
      Begin MSComCtl2.DTPicker DT_Start 
         Height          =   375
         Left            =   1440
         TabIndex        =   4
         Top             =   1080
         Width           =   1695
         _ExtentX        =   2990
         _ExtentY        =   661
         _Version        =   393216
         Enabled         =   0   'False
         CustomFormat    =   "yyy-MM-dd"
         Format          =   26935296
         CurrentDate     =   37111
      End
      Begin VB.TextBox txtSuppID 
         BeginProperty Font 
            Name            =   "宋体"
            Size            =   10.5
            Charset         =   134
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   390
         Left            =   4680
         TabIndex        =   6
         Top             =   480
         Width           =   1695
      End
      Begin VB.TextBox txtSuppName 
         BeginProperty Font 
            Name            =   "宋体"
            Size            =   10.5
            Charset         =   134
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   375
         Left            =   1440
         TabIndex        =   5
         Top             =   480
         Width           =   1695
      End
      Begin MSComCtl2.DTPicker DT_End 
         Height          =   375
         Left            =   4680
         TabIndex        =   7
         Top             =   1080
         Width           =   1695
         _ExtentX        =   2990
         _ExtentY        =   661
         _Version        =   393216
         Enabled         =   0   'False
         CustomFormat    =   "yyy-MM-dd"
         Format          =   26935296
         CurrentDate     =   37111
      End
      Begin VB.CheckBox Check1 
         Caption         =   "注册日期"
         Height          =   255
         Left            =   360
         TabIndex        =   8
         Top             =   1170
         Width           =   1095
      End
      Begin VB.Label label1 
         Alignment       =   1  'Right Justify
         BackStyle       =   0  'Transparent
         Caption         =   "供应商名称"
         Height          =   255
         Left            =   360
         TabIndex        =   11
         Top             =   600
         Width           =   975
      End
      Begin VB.Label Label2 
         Alignment       =   1  'Right Justify
         BackStyle       =   0  'Transparent
         Caption         =   "供应商代码 S"
         Height          =   255
         Left            =   3480
         TabIndex        =   10
         Top             =   600
         Width           =   1215
      End
      Begin VB.Label Label3 
         Alignment       =   1  'Right Justify
         BackStyle       =   0  'Transparent
         Caption         =   "至"
         Height          =   255
         Left            =   4320
         TabIndex        =   9
         Top             =   1200
         Width           =   255
      End
      Begin VB.Shape Shape1 
         BorderColor     =   &H80000001&
         Height          =   615
         Left            =   120
         Top             =   960
         Width           =   6495
      End
   End
   Begin VB.CommandButton cmdExit 
      Caption         =   "退出"
      Height          =   330
      Left            =   7560
      TabIndex        =   2
      Top             =   1320
      Width           =   1200
   End
   Begin VB.CommandButton cmdClear 
      Caption         =   "条件清空"
      Height          =   330
      Left            =   7560
      TabIndex        =   1
      Top             =   840
      Width           =   1200
   End
   Begin VB.CommandButton cmdDelete 
      Caption         =   "删除"
      Default         =   -1  'True
      Height          =   330
      Left            =   7560
      TabIndex        =   0
      Top             =   360
      Width           =   1200
   End
   Begin MSFlexGridLib.MSFlexGrid MSFlexGrid1 
      Height          =   2895
      Left            =   120
      TabIndex        =   12
      Top             =   1920
      Width           =   9015
      _ExtentX        =   15901
      _ExtentY        =   5106
      _Version        =   393216
      Rows            =   6
      Cols            =   26
      FixedCols       =   0
      ScrollTrack     =   -1  'True
      AllowUserResizing=   1
      FormatString    =   $"frmSuppDel.frx":0000
   End
End
Attribute VB_Name = "frmSuppDel"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
    Private blDelete As Boolean             'True表示cmdDelete按钮为“删除”，准备删除了
                                            'False表示cmdDelete按钮为“调出”，点击就按条件显示

Private Sub Check1_Click()
On Error Resume Next
    If Me.Check1.Value = vbChecked Then     '使DTPicker控件可用
        Me.DT_End.Enabled = True
        Me.DT_Start.Enabled = True
    Else                                    '使DTpicker控件不可用
        Me.DT_End.Enabled = False
        Me.DT_Start.Enabled = False
    End If
End Sub

Private Sub cmdDelete_Click()
    Dim Rst As New ADODB.Recordset
    Dim strCheck As String
    Dim strSQL As String
    Dim strItem As String
    
On Error GoTo ErrorExit
    If blDelete = False Then        '说明当前应进行“调出”操作
        Me.MSFlexGrid1.Rows = 1     'MSFlexGrid控件的初始行数为1
        If Me.txtSuppName.Text <> "" Then     '供应商名称的查询条件
            strCheck = " SuppName LIKE '" & Me.txtSuppName.Text & "'"
        End If
        If Me.txtSuppID.Text <> "" Then       '供应商代码的查询条件
            If strCheck <> "" Then
                strCheck = strCheck & " AND "
            End If
            strCheck = strCheck & " SuppID LIKE 'S" & Me.txtSuppID.Text & "'"
        End If
        If Me.Check1.Value = vbChecked Then         '注册日期的查询条件
            If Me.DT_Start.Value > Me.DT_End.Value Then
                MsgBox "起始日期不得大于截止日期！", vbInformation, Me.Caption
                Exit Sub
            Else
                If strCheck <> "" Then
                    strCheck = strCheck & " AND "
                End If
                strCheck = strCheck & "RegeditDate BETWEEN #" & Me.DT_Start.Value & _
                "# AND #" & Me.DT_End.Value & "#"
            End If
        End If
        
        strSQL = "select * from tb_Supplier"       '定义SQL查询语句
        If strCheck <> "" Then
            strSQL = strSQL & " WHERE " & strCheck
        End If
        Rst.Open strSQL, CnnDatabase, adOpenStatic, adLockReadOnly  '打开一个数据集
        If Rst.RecordCount = 0 Then
            MsgBox "数据库中无相关供应商记录！", vbInformation, "请注意"
            Exit Sub
        Else
            Rst.MoveFirst
            Do Until Rst.EOF
            '^ 供应商名称 |^ 供应商代码 |^ 注册日期 |^ 供应商地址 |^ 注册名称 |^ 业务期限 |
            '^ 邮政编码 |^ 邮件地址 |^ 供应商网址 |^ 供货类别 |^ 企业性质 |^ 注册资金(万元) |
            '^ 注册币种 |^ 注册号码 |^ 供应商级别 |^ 税号 |^ 条形码证书 |^ 银行账号 |^ 开户行 |
            '^ 银行信用等级 |^ 法人代表 |^ 法人电话 |^ 法人传真 |^ 经办人 |^ 经办人电话 |^ 经办人传真
                strItem = Rst!SuppName & Chr(9) & Rst!SuppID & Chr(9) & _
                    Format(Rst!RegeditDate, "yyyy年m月d日") & Chr(9) & Rst!SuppAddress & _
                    Chr(9) & Rst!RegeditName & Chr(9) & Format(Rst!LimitStart, "yyyy年m月d日") & _
                    "-→" & Format(Rst!LimitEnd, "yyyy年m月d日") & Chr(9) & Rst!Postcode & _
                    Chr(9) & Rst!Email & Chr(9) & Rst!Website & Chr(9) & Rst!Type & Chr(9) & _
                    Rst!Property & Chr(9) & Rst!Regeditfund & Chr(9) & Rst!RegeditMoney & _
                    Chr(9) & Rst!Regeditcode & Chr(9) & Rst!Supplevel & _
                    Chr(9) & Rst!Taxcode & Chr(9) & Rst!Bar & Chr(9) & Rst!Bankcode & _
                    Chr(9) & Rst!Bankname & Chr(9) & Rst!Banklevel & Chr(9) & Rst!Jurperson & _
                    Chr(9) & Rst!Jurphone & Chr(9) & Rst!Jurfax & Chr(9) & Rst!Viaperson & _
                    Chr(9) & Rst!Viaphone & Chr(9) & Rst!Viafax
                Me.MSFlexGrid1.AddItem strItem      '向MSFlexGrid控件中添加数据
                Me.MSFlexGrid1.ColWidth(2) = 1500   '更改MSFlex控件中两个显示日期的列的宽度
                Me.MSFlexGrid1.ColWidth(5) = 3000   '计算方法：大约一个汉字是200缇，数字100缇。
                Module1.MSFBackColor Me.MSFlexGrid1, Me.MSFlexGrid1.Rows - 1
                Rst.MoveNext
            Loop
        End If
        Set Rst = Nothing   '关闭数据集
        blDelete = True     '设置判断，按钮变为“删除”，再点击时将进行删除操作
        cmdDelete.Caption = "删除"
    Else                    '当前应进行“删除”操作
        blDelete = False    '设置判断，按钮变为“调出”，再点击时将进行调出的操作
        cmdDelete.Caption = "调出"
    End If
    Exit Sub
    
ErrorExit:
    MsgBox Err.Description, vbInformation, Me.Caption
    Set Rst = Nothing
End Sub

Private Sub cmdClear_Click()
    Dim i As Integer    '用于for循环的指针
    
    Initial
    cmdDelete.Caption = "调出"
    blDelete = False    '当前cmdDelete按钮还是“调出”功能
    For i = 0 To 25     '设置MSFlexGrid控件每列宽度
        MSFlexGrid1.ColWidth(i) = 1000
    Next
End Sub

Private Sub cmdExit_Click()
    Unload Me
End Sub

Private Sub Form_Load()
    Dim i As Integer
    Initial             '初始化界面
    cmdDelete.Caption = "调出"
    blDelete = False    '当前cmdDelete按钮还是“调出”功能
    For i = 0 To 25     '设置MSFlexGrid控件每列宽度
        MSFlexGrid1.ColWidth(i) = 1000
    Next
End Sub

Private Sub Initial()               '初始化界面
    Me.txtSuppName = ""             '清除txtUserID控件的内容
    Me.txtSuppID = ""               '清除txtSuppID控件的内容
    Me.Check1.Value = vbUnchecked
    Me.DT_End.Enabled = False
    Me.DT_End.Value = Date
    Me.DT_Start.Enabled = False
    Me.DT_Start.Value = Date
    Me.MSFlexGrid1.Rows = 1
End Sub