frmsuppcheck.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 frmSuppCheck 
   Caption         =   "供应商信息 - [查询]"
   ClientHeight    =   5820
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   7470
   LinkTopic       =   "Form1"
   LockControls    =   -1  'True
   ScaleHeight     =   5820
   ScaleWidth      =   7470
   StartUpPosition =   3  '窗口缺省
   Begin VB.CommandButton cmdCheck 
      Caption         =   "查询"
      Default         =   -1  'True
      Height          =   330
      Left            =   840
      TabIndex        =   19
      Top             =   5400
      Width           =   1200
   End
   Begin VB.CommandButton cmdClear 
      Caption         =   "条件清空"
      Height          =   330
      Left            =   3060
      TabIndex        =   18
      Top             =   5400
      Width           =   1200
   End
   Begin VB.CommandButton cmdExit 
      Caption         =   "退出"
      Height          =   330
      Left            =   5160
      TabIndex        =   17
      Top             =   5400
      Width           =   1200
   End
   Begin VB.Frame Frame1 
      Caption         =   "查询条件"
      BeginProperty Font 
         Name            =   "隶书"
         Size            =   14.25
         Charset         =   134
         Weight          =   700
         Underline       =   0   'False
         Italic          =   -1  'True
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H00FF0000&
      Height          =   2415
      Left            =   240
      TabIndex        =   0
      Top             =   120
      Width           =   6975
      Begin MSComCtl2.DTPicker DT_Start 
         Height          =   375
         Left            =   1440
         TabIndex        =   5
         Top             =   1800
         Width           =   1695
         _ExtentX        =   2990
         _ExtentY        =   661
         _Version        =   393216
         Enabled         =   0   'False
         CustomFormat    =   "yyy-MM-dd"
         Format          =   65929216
         CurrentDate     =   37111
      End
      Begin VB.TextBox txtViaperson 
         BeginProperty Font 
            Name            =   "宋体"
            Size            =   10.5
            Charset         =   134
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   375
         Left            =   4920
         TabIndex        =   11
         Top             =   840
         Width           =   1695
      End
      Begin VB.TextBox txtJurperson 
         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        =   10
         Top             =   840
         Width           =   1695
      End
      Begin VB.ComboBox Combo_Supplevel 
         Height          =   300
         ItemData        =   "frmSuppCheck.frx":0000
         Left            =   4920
         List            =   "frmSuppCheck.frx":0002
         Style           =   2  'Dropdown List
         TabIndex        =   7
         Top             =   1320
         Width           =   1695
      End
      Begin VB.ComboBox Combo_Type 
         Height          =   300
         Left            =   1440
         Style           =   2  'Dropdown List
         TabIndex        =   6
         Top             =   1320
         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        =   2
         Top             =   360
         Width           =   1695
      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            =   4920
         TabIndex        =   1
         Top             =   360
         Width           =   1695
      End
      Begin MSComCtl2.DTPicker DT_End 
         Height          =   375
         Left            =   4920
         TabIndex        =   14
         Top             =   1800
         Width           =   1695
         _ExtentX        =   2990
         _ExtentY        =   661
         _Version        =   393216
         Enabled         =   0   'False
         CustomFormat    =   "yyy-MM-dd"
         Format          =   65929216
         CurrentDate     =   37111
      End
      Begin VB.CheckBox Check1 
         Caption         =   "注册日期"
         Height          =   255
         Left            =   360
         TabIndex        =   20
         Top             =   1890
         Width           =   1095
      End
      Begin VB.Shape Shape1 
         BorderColor     =   &H80000001&
         Height          =   615
         Left            =   120
         Top             =   1680
         Width           =   6735
      End
      Begin VB.Label Label3 
         Alignment       =   1  'Right Justify
         BackStyle       =   0  'Transparent
         Caption         =   "至"
         Height          =   255
         Left            =   4560
         TabIndex        =   15
         Top             =   1920
         Width           =   255
      End
      Begin VB.Label Label17 
         Alignment       =   1  'Right Justify
         BackStyle       =   0  'Transparent
         Caption         =   "经办人"
         Height          =   255
         Left            =   4080
         TabIndex        =   13
         Top             =   960
         Width           =   735
      End
      Begin VB.Label Label14 
         Alignment       =   1  'Right Justify
         BackStyle       =   0  'Transparent
         Caption         =   "法人代表"
         Height          =   255
         Left            =   480
         TabIndex        =   12
         Top             =   960
         Width           =   855
      End
      Begin VB.Label Label26 
         Alignment       =   1  'Right Justify
         BackStyle       =   0  'Transparent
         Caption         =   "供应商级别"
         Height          =   255
         Left            =   3840
         TabIndex        =   9
         Top             =   1440
         Width           =   975
      End
      Begin VB.Label Label_Type 
         Alignment       =   1  'Right Justify
         BackColor       =   &H80000013&
         BackStyle       =   0  'Transparent
         Caption         =   "供货类别"
         Height          =   255
         Left            =   480
         TabIndex        =   8
         Top             =   1440
         Width           =   855
      End
      Begin VB.Label Label2 
         Alignment       =   1  'Right Justify
         BackStyle       =   0  'Transparent
         Caption         =   "供应商代码 S"
         Height          =   255
         Left            =   3720
         TabIndex        =   4
         Top             =   480
         Width           =   1215
      End
      Begin VB.Label label1 
         Alignment       =   1  'Right Justify
         BackStyle       =   0  'Transparent
         Caption         =   "供应商名称"
         Height          =   255
         Left            =   360
         TabIndex        =   3
         Top             =   480
         Width           =   975
      End
   End
   Begin MSFlexGridLib.MSFlexGrid MSFlexGrid1 
      Height          =   2535
      Left            =   120
      TabIndex        =   16
      Top             =   2640
      Width           =   7215
      _ExtentX        =   12726
      _ExtentY        =   4471
      _Version        =   393216
      Rows            =   6
      Cols            =   26
      FixedCols       =   0
      ScrollTrack     =   -1  'True
      AllowUserResizing=   1
      FormatString    =   $"frmSuppCheck.frx":0004
   End
End
Attribute VB_Name = "frmSuppCheck"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

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 cmdCheck_Click()
    Dim Rst As New ADODB.Recordset
    Dim strCheck As String
    Dim strSQL As String
    Dim strItem As String
    
On Error GoTo ErrorExit
    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.txtJurperson.Text <> "" Then    '法人代表的查询条件
        If strCheck <> "" Then
            strCheck = strCheck & " AND "
        End If
        strCheck = strCheck & " Jurperson ='" & Me.txtJurperson.Text & "'"
    End If
    If Me.txtViaperson.Text <> "" Then    '经办人查询条件
        If strCheck <> "" Then
            strCheck = strCheck & " AND "
        End If
        strCheck = strCheck & " Viaperson ='" & Me.txtViaperson.Text & "'"
    End If
    If Me.Combo_Type.Text <> "" Then           '供货类别查询条件
        If strCheck <> "" Then
            strCheck = strCheck & " AND "
        End If
        strCheck = strCheck & "Type ='" & Me.Combo_Type.Text & "'"
    End If
    If Me.Combo_Supplevel.Text <> "" Then       '供应商级别的查询条件
        If strCheck <> "" Then
            strCheck = strCheck & " AND "
        End If
        strCheck = strCheck & "Supplevel ='" & Me.Combo_Supplevel.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   '关闭数据集
    Exit Sub
    
ErrorExit:
    MsgBox Err.Description, vbInformation, Me.Caption
    Set Rst = Nothing
End Sub

Private Sub cmdClear_Click()
    Initial
End Sub

Private Sub cmdExit_Click()
    Unload Me
End Sub

Private Sub Form_Load()
    Dim i As Integer
    Initial
    For i = 0 To 25     '设置MSFlexGrid控件每列宽度
        MSFlexGrid1.ColWidth(i) = 1000
    Next
End Sub

Private Sub Initial()               '初始化界面
    Me.txtSuppName = ""             '清除txtUserID控件的内容
    Me.txtSuppID = ""               '清除txtSuppID控件的内容
    Me.txtJurperson = ""            '清除txtJurperson控件的内容
    Me.txtViaperson = ""            '清除txtViaperson控件的内容
    Me.Combo_Type.ListIndex = -1
    Me.Combo_Supplevel.ListIndex = -1
    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