www.pudn.com > vb-sql-server.rar > frmSSetup1.frm, change:2003-06-17,size:13362b


VERSION 5.00 
Begin VB.Form frmSSetup1  
   BorderStyle     =   3  'Fixed Dialog 
   Caption         =   "服务设置信息" 
   ClientHeight    =   3900 
   ClientLeft      =   48 
   ClientTop       =   336 
   ClientWidth     =   6228 
   LinkTopic       =   "Form1" 
   MaxButton       =   0   'False 
   MinButton       =   0   'False 
   ScaleHeight     =   3900 
   ScaleWidth      =   6228 
   ShowInTaskbar   =   0   'False 
   StartUpPosition =   1  'CenterOwner 
   Begin VB.TextBox txtItem  
      Height          =   270 
      Index           =   9 
      Left            =   5280 
      MaxLength       =   20 
      TabIndex        =   22 
      Top             =   3480 
      Visible         =   0   'False 
      Width           =   735 
   End 
   Begin VB.Frame Frame1  
      Caption         =   "服务信息:" 
      Height          =   3132 
      Left            =   120 
      TabIndex        =   4 
      Top             =   120 
      Width           =   6012 
      Begin VB.TextBox txtItem  
         Height          =   270 
         Index           =   10 
         Left            =   3720 
         MaxLength       =   8 
         TabIndex        =   23 
         ToolTipText     =   "双击鼠标可以选择类别" 
         Top             =   720 
         Width           =   2055 
      End 
      Begin VB.TextBox txtItem  
         Height          =   840 
         Index           =   8 
         Left            =   1200 
         MaxLength       =   100 
         MultiLine       =   -1  'True 
         ScrollBars      =   2  'Vertical 
         TabIndex        =   21 
         Top             =   2160 
         Width           =   4572 
      End 
      Begin VB.TextBox txtItem  
         Height          =   276 
         Index           =   7 
         Left            =   3720 
         MaxLength       =   10 
         ScrollBars      =   2  'Vertical 
         TabIndex        =   20 
         Top             =   1800 
         Width           =   2052 
      End 
      Begin VB.TextBox txtItem  
         Height          =   276 
         Index           =   6 
         Left            =   1200 
         MaxLength       =   25 
         ScrollBars      =   2  'Vertical 
         TabIndex        =   19 
         Top             =   1080 
         Width           =   4572 
      End 
      Begin VB.TextBox txtItem  
         Height          =   276 
         Index           =   5 
         Left            =   1200 
         MaxLength       =   10 
         ScrollBars      =   2  'Vertical 
         TabIndex        =   18 
         Top             =   1800 
         Width           =   1572 
      End 
      Begin VB.TextBox txtItem  
         Height          =   276 
         Index           =   4 
         Left            =   3720 
         MaxLength       =   10 
         ScrollBars      =   2  'Vertical 
         TabIndex        =   17 
         Top             =   1440 
         Width           =   2052 
      End 
      Begin VB.TextBox txtItem  
         Height          =   276 
         Index           =   3 
         Left            =   1200 
         MaxLength       =   10 
         ScrollBars      =   2  'Vertical 
         TabIndex        =   16 
         Top             =   1440 
         Width           =   1572 
      End 
      Begin VB.TextBox txtItem  
         Height          =   276 
         Index           =   2 
         Left            =   1200 
         MaxLength       =   10 
         ScrollBars      =   2  'Vertical 
         TabIndex        =   14 
         Top             =   720 
         Width           =   1572 
      End 
      Begin VB.TextBox txtItem  
         Height          =   270 
         Index           =   0 
         Left            =   1200 
         MaxLength       =   8 
         TabIndex        =   0 
         Top             =   360 
         Width           =   1572 
      End 
      Begin VB.TextBox txtItem  
         Height          =   270 
         Index           =   1 
         Left            =   3720 
         MaxLength       =   20 
         TabIndex        =   1 
         Top             =   360 
         Width           =   2052 
      End 
      Begin VB.Label Label2  
         Caption         =   "备注信息:" 
         Height          =   252 
         Index           =   10 
         Left            =   360 
         TabIndex        =   15 
         Top             =   2160 
         Width           =   1092 
      End 
      Begin VB.Label Label2  
         Caption         =   "设置日期:" 
         Height          =   252 
         Index           =   9 
         Left            =   2880 
         TabIndex        =   13 
         Top             =   1800 
         Width           =   1092 
      End 
      Begin VB.Label Label2  
         Caption         =   "运  营  商:" 
         Height          =   252 
         Index           =   4 
         Left            =   360 
         TabIndex        =   12 
         Top             =   1080 
         Width           =   1092 
      End 
      Begin VB.Label Label2  
         Caption         =   "零售价格:" 
         Height          =   252 
         Index           =   3 
         Left            =   360 
         TabIndex        =   11 
         Top             =   1800 
         Width           =   1092 
      End 
      Begin VB.Label Label2  
         Caption         =   "分销价格:" 
         Height          =   252 
         Index           =   2 
         Left            =   2880 
         TabIndex        =   10 
         Top             =   1440 
         Width           =   1092 
      End 
      Begin VB.Label Label2  
         Caption         =   "入库价格:" 
         Height          =   252 
         Index           =   8 
         Left            =   360 
         TabIndex        =   9 
         Top             =   1440 
         Width           =   1092 
      End 
      Begin VB.Label Label2  
         Caption         =   "类        别:" 
         Height          =   252 
         Index           =   7 
         Left            =   2880 
         TabIndex        =   8 
         Top             =   720 
         Width           =   1092 
      End 
      Begin VB.Label Label2  
         Caption         =   "单        位:" 
         Height          =   252 
         Index           =   5 
         Left            =   360 
         TabIndex        =   7 
         Top             =   720 
         Width           =   1092 
      End 
      Begin VB.Label Label2  
         Caption         =   "服务编号:" 
         Height          =   252 
         Index           =   0 
         Left            =   360 
         TabIndex        =   6 
         Top             =   360 
         Width           =   1092 
      End 
      Begin VB.Label Label2  
         Caption         =   "名        称:" 
         Height          =   252 
         Index           =   1 
         Left            =   2880 
         TabIndex        =   5 
         Top             =   360 
         Width           =   1092 
      End 
   End 
   Begin VB.CommandButton cmdExit  
      Caption         =   "返回 (&X)" 
      Height          =   375 
      Left            =   3000 
      TabIndex        =   3 
      Top             =   3360 
      Width           =   1215 
   End 
   Begin VB.CommandButton cmdSave  
      Caption         =   "保存 (&S)" 
      Height          =   375 
      Left            =   1560 
      TabIndex        =   2 
      Top             =   3360 
      Width           =   1215 
   End 
End 
Attribute VB_Name = "frmSSetup1" 
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 
Public flagS As Boolean 
 
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 7 
        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 = "设置日期" 
            End Select 
            sMeg = sMeg & "不能为空!" 
            MsgBox sMeg, vbOKOnly + vbExclamation, "警告" 
            txtItem(intCount).SetFocus 
            Exit Sub 
        End If 
    Next intCount 
     
    For intCount = 3 To 5 
        If Not IsNumeric(Trim(txtItem(intCount))) Then 
            sMeg = "产品价格" 
            sMeg = sMeg & "请输入数字!" 
            MsgBox sMeg, vbOKOnly + vbExclamation, "警告" 
            txtItem(intCount).SetFocus 
            Exit Sub 
        End If 
    Next intCount 
    
    '添加判断是否有相同的ID记录 
    If gintSSmode = 1 Then 
        txtSQL = "select * from dm_service 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_service where dm ='" & Trim(txtItem(0)) & "'" 
    Set mrc = ExecuteSQL(txtSQL, MsgText) 
    
     
    '再加入新记录 
    txtSQL = "execute service_setup '" 
    For intCount = 0 To 2 
        txtSQL = txtSQL & Trim(txtItem(intCount)) & "','" 
    Next intCount 
     
    txtSQL = txtSQL & Trim(txtItem(9)) & "','" 
 
     
    For intCount = 3 To 7 
        txtSQL = txtSQL & Trim(txtItem(intCount)) & "','" 
    Next intCount 
     
    txtSQL = txtSQL & Trim(txtItem(8)) & "'" 
     
         
    Set mrc = ExecuteSQL(txtSQL, MsgText) 
         
    If gintSSmode = 1 Then 
        MsgBox "添加记录成功!", vbOKOnly + vbExclamation, "添加记录" 
        For intCount = 0 To 8 
            txtItem(intCount) = "" 
        Next intCount 
         
  
         
         
        txtItem(7) = Format(Now, "yyyy-mm-dd") 
         
        mblChange = False 
         
        Unload frmSSetup 
        frmSSetup.txtSQL = "select * from dm_service" 
        frmSSetup.Show 
         
    ElseIf gintSSmode = 2 Then 
        Unload Me 
        Unload frmSSetup 
         
        frmSSetup.txtSQL = "select * from dm_service" 
        frmSSetup.Show 
    End If 
     
End Sub 
 
 
 
 
 
Private Sub Combo1_Change() 
    mblChange = True 
End Sub 
 
Private Sub Combo1_Click() 
    If Not flagS Then 
        frmSLBS.Show 1 
    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 gintSSmode = 1 Then 
        Me.Caption = Me.Caption & "添加" 
        For i = 0 To 10 
            txtItem(i).Text = "" 
        Next i 
         
 
        txtItem(10) = "双击选择服务类别" 
         
         
 
    ElseIf gintSSmode = 2 Then 
        Set mrc = ExecuteSQL(txtSQL, MsgText) 
         
        If mrc.EOF = False Then 
            With mrc 
                For intCount = 0 To 2 
                    txtItem(intCount) = .Fields(intCount) 
                Next intCount 
                 
                txtSQL = "select lbcode1,lb1 from dm_slb where lbcode1 = '" & .Fields(3) & "'" 
                Set mrcc = ExecuteSQL(txtSQL, MsgText) 
                 
                If Not mrcc.EOF Then 
                     txtItem(9) = mrcc.Fields(0) 
                     txtItem(10) = mrcc.Fields(1) 
                     mrcc.Close 
                End If 
                 
                 
                For intCount = 3 To 8 
                    txtItem(intCount) = .Fields(intCount + 1) 
                Next intCount 
                
            End With 
             
            mrc.Close 
            txtItem(0).Enabled = False 
        End If 
         
        Me.Caption = Me.Caption & "修改" 
    End If 
     
     
    flagS = False 
     
    txtItem(7) = Format(Now, "yyyy-mm-dd") 
    txtItem(7).Enabled = False 
     
     
     
     
     
     
    mblChange = False 
End Sub 
 
Private Sub Form_Unload(Cancel As Integer) 
    gintSSmode = 0 
End Sub 
 
 
 
Private Sub txtItem_Change(Index As Integer) 
    '有变化设置gblchange 
    mblChange = True 
End Sub 
 
 
Private Sub txtItem_DblClick(Index As Integer) 
    If Index = 10 Then 
        frmSLBS.Show 1 
    End If 
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