www.pudn.com > vb-sql-server.rar > frmKHSetup1.frm, change:2003-06-18,size:14447b


VERSION 5.00 
Begin VB.Form frmKHSetup1  
   BorderStyle     =   3  'Fixed Dialog 
   Caption         =   "客户设置信息" 
   ClientHeight    =   5220 
   ClientLeft      =   48 
   ClientTop       =   336 
   ClientWidth     =   6516 
   LinkTopic       =   "Form1" 
   MaxButton       =   0   'False 
   MinButton       =   0   'False 
   ScaleHeight     =   5220 
   ScaleWidth      =   6516 
   ShowInTaskbar   =   0   'False 
   StartUpPosition =   1  'CenterOwner 
   Begin VB.Frame Frame1  
      Caption         =   "客户设置:" 
      Height          =   4452 
      Left            =   120 
      TabIndex        =   2 
      Top             =   120 
      Width           =   6132 
      Begin VB.TextBox txtItem  
         Height          =   960 
         Index           =   13 
         Left            =   1200 
         MaxLength       =   80 
         MultiLine       =   -1  'True 
         ScrollBars      =   2  'Vertical 
         TabIndex        =   30 
         Top             =   3240 
         Width           =   4692 
      End 
      Begin VB.TextBox txtItem  
         Height          =   276 
         Index           =   12 
         Left            =   3840 
         MaxLength       =   10 
         ScrollBars      =   2  'Vertical 
         TabIndex        =   29 
         Top             =   2880 
         Width           =   2052 
      End 
      Begin VB.TextBox txtItem  
         Height          =   276 
         Index           =   11 
         Left            =   1200 
         MaxLength       =   10 
         ScrollBars      =   2  'Vertical 
         TabIndex        =   28 
         Top             =   2880 
         Width           =   1572 
      End 
      Begin VB.TextBox txtItem  
         Height          =   276 
         Index           =   10 
         Left            =   1200 
         MaxLength       =   50 
         ScrollBars      =   2  'Vertical 
         TabIndex        =   27 
         Top             =   2520 
         Width           =   4692 
      End 
      Begin VB.TextBox txtItem  
         Height          =   270 
         Index           =   1 
         Left            =   3840 
         MaxLength       =   20 
         TabIndex        =   12 
         Top             =   360 
         Width           =   2052 
      End 
      Begin VB.TextBox txtItem  
         Height          =   270 
         Index           =   0 
         Left            =   1200 
         MaxLength       =   8 
         TabIndex        =   11 
         Top             =   360 
         Width           =   1572 
      End 
      Begin VB.TextBox txtItem  
         Height          =   276 
         Index           =   2 
         Left            =   1200 
         MaxLength       =   40 
         ScrollBars      =   2  'Vertical 
         TabIndex        =   10 
         Top             =   720 
         Width           =   4692 
      End 
      Begin VB.TextBox txtItem  
         Height          =   276 
         Index           =   3 
         Left            =   1200 
         MaxLength       =   10 
         ScrollBars      =   2  'Vertical 
         TabIndex        =   9 
         Top             =   1080 
         Width           =   1572 
      End 
      Begin VB.TextBox txtItem  
         Height          =   276 
         Index           =   4 
         Left            =   3840 
         MaxLength       =   20 
         ScrollBars      =   2  'Vertical 
         TabIndex        =   8 
         Top             =   1080 
         Width           =   2052 
      End 
      Begin VB.TextBox txtItem  
         Height          =   276 
         Index           =   5 
         Left            =   1200 
         MaxLength       =   40 
         ScrollBars      =   2  'Vertical 
         TabIndex        =   7 
         Top             =   1440 
         Width           =   4692 
      End 
      Begin VB.TextBox txtItem  
         Height          =   276 
         Index           =   6 
         Left            =   1200 
         MaxLength       =   25 
         ScrollBars      =   2  'Vertical 
         TabIndex        =   6 
         Top             =   1800 
         Width           =   1572 
      End 
      Begin VB.TextBox txtItem  
         Height          =   276 
         Index           =   7 
         Left            =   3840 
         MaxLength       =   40 
         ScrollBars      =   2  'Vertical 
         TabIndex        =   5 
         Top             =   1800 
         Width           =   2052 
      End 
      Begin VB.TextBox txtItem  
         Height          =   276 
         Index           =   8 
         Left            =   1200 
         MaxLength       =   20 
         ScrollBars      =   2  'Vertical 
         TabIndex        =   4 
         Top             =   2160 
         Width           =   1572 
      End 
      Begin VB.TextBox txtItem  
         Height          =   276 
         Index           =   9 
         Left            =   3840 
         MaxLength       =   20 
         ScrollBars      =   2  'Vertical 
         TabIndex        =   3 
         Top             =   2160 
         Width           =   2052 
      End 
      Begin VB.Label Label2  
         Caption         =   "折 扣 比 例:" 
         Height          =   252 
         Index           =   13 
         Left            =   2880 
         TabIndex        =   26 
         Top             =   2880 
         Width           =   1092 
      End 
      Begin VB.Label Label2  
         Caption         =   "会 员 卡 号:" 
         Height          =   252 
         Index           =   12 
         Left            =   240 
         TabIndex        =   25 
         Top             =   2880 
         Width           =   1092 
      End 
      Begin VB.Label Label2  
         Caption         =   "客 户 名 称:" 
         Height          =   252 
         Index           =   1 
         Left            =   2880 
         TabIndex        =   24 
         Top             =   360 
         Width           =   1092 
      End 
      Begin VB.Label Label2  
         Caption         =   "客 户 代 码:" 
         Height          =   252 
         Index           =   0 
         Left            =   240 
         TabIndex        =   23 
         Top             =   360 
         Width           =   1092 
      End 
      Begin VB.Label Label2  
         Caption         =   "地            址:" 
         Height          =   252 
         Index           =   5 
         Left            =   240 
         TabIndex        =   22 
         Top             =   720 
         Width           =   1092 
      End 
      Begin VB.Label Label2  
         Caption         =   "邮 政 编 码:" 
         Height          =   252 
         Index           =   6 
         Left            =   240 
         TabIndex        =   21 
         Top             =   1080 
         Width           =   1092 
      End 
      Begin VB.Label Label2  
         Caption         =   "联 系 电 话:" 
         Height          =   252 
         Index           =   7 
         Left            =   2880 
         TabIndex        =   20 
         Top             =   1080 
         Width           =   1092 
      End 
      Begin VB.Label Label2  
         Caption         =   "网           址:" 
         Height          =   252 
         Index           =   8 
         Left            =   240 
         TabIndex        =   19 
         Top             =   1440 
         Width           =   1092 
      End 
      Begin VB.Label Label2  
         Caption         =   "电 子 邮 件:" 
         Height          =   252 
         Index           =   2 
         Left            =   2880 
         TabIndex        =   18 
         Top             =   1800 
         Width           =   1092 
      End 
      Begin VB.Label Label2  
         Caption         =   "税           号:" 
         Height          =   252 
         Index           =   3 
         Left            =   240 
         TabIndex        =   17 
         Top             =   2160 
         Width           =   1092 
      End 
      Begin VB.Label Label2  
         Caption         =   "账           号:" 
         Height          =   252 
         Index           =   4 
         Left            =   2880 
         TabIndex        =   16 
         Top             =   2160 
         Width           =   1092 
      End 
      Begin VB.Label Label2  
         Caption         =   "联    系   人:" 
         Height          =   252 
         Index           =   9 
         Left            =   240 
         TabIndex        =   15 
         Top             =   1800 
         Width           =   1092 
      End 
      Begin VB.Label Label2  
         Caption         =   "备 注 信 息:" 
         Height          =   252 
         Index           =   10 
         Left            =   240 
         TabIndex        =   14 
         Top             =   3240 
         Width           =   1092 
      End 
      Begin VB.Label Label2  
         Caption         =   "开 户 银 行:" 
         Height          =   252 
         Index           =   11 
         Left            =   240 
         TabIndex        =   13 
         Top             =   2520 
         Width           =   1092 
      End 
   End 
   Begin VB.CommandButton cmdExit  
      Caption         =   "返回 (&X)" 
      Height          =   375 
      Left            =   3120 
      TabIndex        =   1 
      Top             =   4680 
      Width           =   1215 
   End 
   Begin VB.CommandButton cmdSave  
      Caption         =   "保存 (&S)" 
      Height          =   375 
      Left            =   1680 
      TabIndex        =   0 
      Top             =   4680 
      Width           =   1215 
   End 
End 
Attribute VB_Name = "frmKHSetup1" 
Attribute VB_GlobalNameSpace = False 
Attribute VB_Creatable = False 
Attribute VB_PredeclaredId = True 
Attribute VB_Exposed = False 
Option Explicit 
'是否改动过记录,ture为改过 
Dim mblChange As Boolean 
Dim mrc As ADODB.Recordset 
Public txtSQL As String 
 
Private Sub cmdExit_Click() 
    If mblChange And cmdSave.Enabled Then 
        If MsgBox("保存当前记录的变化吗?", vbOKCancel + vbExclamation, "警告") = vbOK Then 
            '保存 
            Call cmdSave_Click 
        End If 
    End If 
    Unload Me 
End Sub 
 
Private Sub cmdSave_Click() 
    Dim intCount As Integer 
    Dim sMeg As String 
    Dim MsgText As String 
     
   
    For intCount = 0 To 12 
        If Trim(txtItem(intCount) & " ") = "" Then 
            Select Case intCount 
                Case 0 
                    sMeg = "客户代码" 
                Case 1 
                    sMeg = "客户名称" 
                Case 2 
                    sMeg = "地址" 
                Case 3 
                    sMeg = "邮政编码" 
                Case 4 
                    sMeg = "电话号码" 
                Case 5 
                    sMeg = "网址" 
                Case 6 
                    sMeg = "联系人" 
                Case 7 
                    sMeg = "电子邮件" 
                Case 8 
                    sMeg = "税号" 
                Case 9 
                    sMeg = "账号" 
                Case 10 
                    sMeg = "开户银行" 
                Case 11 
                    sMeg = "会员卡号" 
                Case 12 
                    sMeg = "折扣比例" 
            End Select 
            sMeg = sMeg & "不能为空!" 
            MsgBox sMeg, vbOKOnly + vbExclamation, "警告" 
            txtItem(intCount).SetFocus 
            Exit Sub 
        End If 
    Next intCount 
     
     
        If Not IsNumeric(Trim(txtItem(12))) Then 
            sMeg = "这口比例" 
            sMeg = sMeg & "请输入数字!" 
            MsgBox sMeg, vbOKOnly + vbExclamation, "警告" 
            txtItem(12).SetFocus 
            Exit Sub 
        End If 
     
     
    
    '添加判断是否有相同的ID记录 
    If gintKHSmode = 1 Then 
        txtSQL = "select * from dm_kh where dm ='" & Trim(txtItem(0)) & "'" 
        Set mrc = ExecuteSQL(txtSQL, MsgText) 
        If mrc.EOF = False Then 
            MsgBox "已经存在此客户代码的记录!", vbOKOnly + vbExclamation, "警告" 
            txtItem(0).SetFocus 
            Exit Sub 
        End If 
        mrc.Close 
    End If 
     
     
    '先删除已有记录 
    txtSQL = "delete from dm_kh where dm ='" & Trim(txtItem(0)) & "'" 
    Set mrc = ExecuteSQL(txtSQL, MsgText) 
    
     
    '再加入新记录 
    txtSQL = "execute kh_setup '" 
    For intCount = 0 To 12 
        txtSQL = txtSQL & Trim(txtItem(intCount)) & "','" 
    Next intCount 
     
    txtSQL = txtSQL & Trim(txtItem(13)) & "'" 
     
 
     
    Set mrc = ExecuteSQL(txtSQL, MsgText) 
         
    If gintKHSmode = 1 Then 
        MsgBox "添加记录成功!", vbOKOnly + vbExclamation, "添加记录" 
        For intCount = 0 To 13 
            txtItem(intCount) = "" 
        Next intCount 
         
        mblChange = False 
         
        Unload frmKHSetup 
        frmKHSetup.txtSQL = "select * from dm_kh" 
        frmKHSetup.Show 
         
    ElseIf gintKHSmode = 2 Then 
        Unload Me 
        Unload frmKHSetup 
         
        frmKHSetup.txtSQL = "select * from dm_kh" 
        frmKHSetup.Show 
    End If 
     
End Sub 
Private Sub Form_Load() 
    Dim intCount As Integer 
    Dim MsgText As String 
    Dim i As Integer 
    Dim mrcc As ADODB.Recordset 
   
    If gintKHSmode = 1 Then 
        Me.Caption = Me.Caption & "添加" 
        For i = 0 To 13 
            txtItem(i).Text = "" 
        Next i 
         
    ElseIf gintKHSmode = 2 Then 
        Set mrc = ExecuteSQL(txtSQL, MsgText) 
         
        If mrc.EOF = False Then 
            With mrc 
                For intCount = 0 To 13 
                    txtItem(intCount) = .Fields(intCount) 
                Next intCount 
            End With 
            txtItem(0).Enabled = False 
        End If 
         
        Me.Caption = Me.Caption & "修改" 
    End If 
     
    mblChange = False 
End Sub 
 
Private Sub Form_Unload(Cancel As Integer) 
    gintGFSmode = 0 
End Sub 
 
 
 
Private Sub txtItem_Change(Index As Integer) 
    '有变化设置gblchange 
    mblChange = True 
End Sub 
 
Private Sub txtItem_GotFocus(Index As Integer) 
    txtItem(Index).SelStart = 0 
    txtItem(Index).SelLength = Len(txtItem(Index)) 
End Sub 
 
Private Sub txtItem_KeyDown(Index As Integer, KeyCode As Integer, Shift As Integer) 
    EnterToTab KeyCode 
End Sub