www.pudn.com > vb-sql-server.rar > frmINH1.frm, change:2003-11-26,size:36010b


VERSION 5.00 
Begin VB.Form frmINH1  
   BorderStyle     =   3  'Fixed Dialog 
   Caption         =   "入库单信息" 
   ClientHeight    =   7236 
   ClientLeft      =   48 
   ClientTop       =   336 
   ClientWidth     =   6132 
   LinkTopic       =   "Form1" 
   MaxButton       =   0   'False 
   MinButton       =   0   'False 
   ScaleHeight     =   7236 
   ScaleWidth      =   6132 
   ShowInTaskbar   =   0   'False 
   StartUpPosition =   1  'CenterOwner 
   Begin VB.TextBox txtItem  
      Height          =   276 
      Index           =   11 
      Left            =   480 
      MaxLength       =   200 
      MultiLine       =   -1  'True 
      TabIndex        =   44 
      Top             =   6600 
      Visible         =   0   'False 
      Width           =   492 
   End 
   Begin VB.TextBox txtQIHAO  
      Height          =   372 
      Left            =   4920 
      TabIndex        =   42 
      Text            =   "txtSL" 
      Top             =   6600 
      Visible         =   0   'False 
      Width           =   252 
   End 
   Begin VB.TextBox txtCKDM  
      Height          =   372 
      Left            =   960 
      TabIndex        =   40 
      Text            =   "txtSL" 
      Top             =   6840 
      Visible         =   0   'False 
      Width           =   252 
   End 
   Begin VB.TextBox txtWZDM  
      Height          =   372 
      Left            =   5760 
      TabIndex        =   39 
      Text            =   "txtSL" 
      Top             =   6600 
      Visible         =   0   'False 
      Width           =   252 
   End 
   Begin VB.TextBox txtZKE  
      Height          =   372 
      Left            =   5400 
      TabIndex        =   38 
      Text            =   "Text2" 
      Top             =   6600 
      Visible         =   0   'False 
      Width           =   252 
   End 
   Begin VB.TextBox txtSL  
      Height          =   372 
      Left            =   4440 
      TabIndex        =   37 
      Text            =   "txtSL" 
      Top             =   6600 
      Visible         =   0   'False 
      Width           =   252 
   End 
   Begin VB.TextBox txtItem  
      Height          =   276 
      Index           =   10 
      Left            =   240 
      MaxLength       =   200 
      MultiLine       =   -1  'True 
      TabIndex        =   36 
      Top             =   6840 
      Visible         =   0   'False 
      Width           =   492 
   End 
   Begin VB.Frame Frame1  
      Caption         =   "支付方式:" 
      Height          =   612 
      Index           =   4 
      Left            =   120 
      TabIndex        =   33 
      Top             =   4200 
      Width           =   6012 
      Begin VB.TextBox txtItem  
         Height          =   276 
         Index           =   8 
         Left            =   3720 
         MaxLength       =   200 
         MultiLine       =   -1  'True 
         TabIndex        =   12 
         Top             =   240 
         Width           =   2052 
      End 
      Begin VB.ComboBox Combo1  
         Height          =   288 
         Index           =   5 
         Left            =   1080 
         Style           =   2  'Dropdown List 
         TabIndex        =   11 
         Top             =   240 
         Width           =   1572 
      End 
      Begin VB.Label Label2  
         Caption         =   "方式选择:" 
         Height          =   252 
         Index           =   14 
         Left            =   360 
         TabIndex        =   35 
         Top             =   240 
         Width           =   1092 
      End 
      Begin VB.Label Label2  
         Caption         =   "预付比例:" 
         Height          =   252 
         Index           =   13 
         Left            =   2880 
         TabIndex        =   34 
         Top             =   240 
         Width           =   1092 
      End 
   End 
   Begin VB.Frame Frame1  
      Caption         =   "其它信息:" 
      Height          =   1572 
      Index           =   3 
      Left            =   120 
      TabIndex        =   29 
      Top             =   4920 
      Width           =   6012 
      Begin VB.TextBox txtItem  
         Height          =   1200 
         Index           =   9 
         Left            =   240 
         MaxLength       =   200 
         MultiLine       =   -1  'True 
         ScrollBars      =   2  'Vertical 
         TabIndex        =   13 
         Top             =   240 
         Width           =   5532 
      End 
   End 
   Begin VB.Frame Frame1  
      Caption         =   "产品信息:" 
      Height          =   1692 
      Index           =   2 
      Left            =   120 
      TabIndex        =   23 
      Top             =   2400 
      Width           =   6012 
      Begin VB.ComboBox Combo1  
         Height          =   288 
         Index           =   3 
         Left            =   1080 
         Style           =   2  'Dropdown List 
         TabIndex        =   43 
         Top             =   240 
         Width           =   1572 
      End 
      Begin VB.TextBox txtItem  
         Height          =   276 
         Index           =   7 
         Left            =   1080 
         MaxLength       =   200 
         MultiLine       =   -1  'True 
         TabIndex        =   10 
         Top             =   1320 
         Width           =   1575 
      End 
      Begin VB.TextBox txtItem  
         Height          =   270 
         Index           =   6 
         Left            =   3720 
         MaxLength       =   20 
         TabIndex        =   9 
         Top             =   960 
         Width           =   2052 
      End 
      Begin VB.TextBox txtItem  
         Height          =   270 
         Index           =   5 
         Left            =   1080 
         MaxLength       =   20 
         TabIndex        =   8 
         Top             =   960 
         Width           =   1575 
      End 
      Begin VB.TextBox txtItem  
         Height          =   270 
         Index           =   4 
         Left            =   3720 
         MaxLength       =   20 
         TabIndex        =   7 
         Top             =   600 
         Width           =   2052 
      End 
      Begin VB.TextBox txtItem  
         Height          =   270 
         Index           =   3 
         Left            =   3720 
         MaxLength       =   20 
         TabIndex        =   5 
         Top             =   240 
         Width           =   2052 
      End 
      Begin VB.ComboBox Combo1  
         Height          =   288 
         Index           =   2 
         Left            =   1080 
         Style           =   2  'Dropdown List 
         TabIndex        =   6 
         Top             =   600 
         Width           =   1572 
      End 
      Begin VB.Label Label2  
         Caption         =   "型        号:" 
         Height          =   252 
         Index           =   3 
         Left            =   240 
         TabIndex        =   41 
         Top             =   240 
         Width           =   1092 
      End 
      Begin VB.Label Label2  
         Caption         =   "入库金额:" 
         Height          =   252 
         Index           =   6 
         Left            =   240 
         TabIndex        =   30 
         Top             =   1320 
         Width           =   1092 
      End 
      Begin VB.Label Label2  
         Caption         =   "折扣比例:" 
         Height          =   252 
         Index           =   2 
         Left            =   2880 
         TabIndex        =   28 
         Top             =   960 
         Width           =   1092 
      End 
      Begin VB.Label Label2  
         Caption         =   "入库单价:" 
         Height          =   252 
         Index           =   11 
         Left            =   240 
         TabIndex        =   27 
         Top             =   960 
         Width           =   1092 
      End 
      Begin VB.Label Label2  
         Caption         =   "数       量:" 
         Height          =   252 
         Index           =   10 
         Left            =   2880 
         TabIndex        =   26 
         Top             =   600 
         Width           =   1092 
      End 
      Begin VB.Label Label2  
         Caption         =   "产品编号:" 
         Height          =   252 
         Index           =   9 
         Left            =   2880 
         TabIndex        =   25 
         Top             =   240 
         Width           =   1092 
      End 
      Begin VB.Label Label2  
         Caption         =   "产品名称:" 
         Height          =   252 
         Index           =   8 
         Left            =   240 
         TabIndex        =   24 
         Top             =   600 
         Width           =   1092 
      End 
   End 
   Begin VB.Frame Frame1  
      Caption         =   "供应商信息:" 
      Height          =   852 
      Index           =   1 
      Left            =   120 
      TabIndex        =   20 
      Top             =   1440 
      Width           =   6012 
      Begin VB.TextBox txtItem  
         Height          =   270 
         Index           =   2 
         Left            =   1200 
         MaxLength       =   20 
         TabIndex        =   3 
         Top             =   360 
         Width           =   1572 
      End 
      Begin VB.ComboBox Combo1  
         Height          =   288 
         Index           =   1 
         Left            =   3720 
         Style           =   2  'Dropdown List 
         TabIndex        =   4 
         Top             =   360 
         Width           =   2052 
      End 
      Begin VB.Label Label2  
         Caption         =   "供应商名称:" 
         Height          =   252 
         Index           =   7 
         Left            =   2880 
         TabIndex        =   22 
         Top             =   360 
         Width           =   1092 
      End 
      Begin VB.Label Label2  
         Caption         =   "供应商代码:" 
         Height          =   255 
         Index           =   4 
         Left            =   240 
         TabIndex        =   21 
         Top             =   360 
         Width           =   1095 
      End 
   End 
   Begin VB.Frame Frame1  
      Caption         =   "入库单基本信息:" 
      Height          =   1212 
      Index           =   0 
      Left            =   120 
      TabIndex        =   16 
      Top             =   120 
      Width           =   6012 
      Begin VB.ComboBox Combo1  
         Height          =   288 
         Index           =   4 
         Left            =   3720 
         Style           =   2  'Dropdown List 
         TabIndex        =   32 
         Top             =   720 
         Width           =   2052 
      End 
      Begin VB.TextBox txtItem  
         Height          =   270 
         Index           =   1 
         Left            =   1200 
         MaxLength       =   20 
         TabIndex        =   2 
         Top             =   720 
         Width           =   1572 
      End 
      Begin VB.ComboBox Combo1  
         Height          =   288 
         Index           =   0 
         Left            =   3720 
         Style           =   2  'Dropdown List 
         TabIndex        =   1 
         Top             =   360 
         Width           =   2052 
      End 
      Begin VB.TextBox txtItem  
         Height          =   270 
         Index           =   0 
         Left            =   1200 
         MaxLength       =   20 
         TabIndex        =   0 
         Top             =   360 
         Width           =   1572 
      End 
      Begin VB.Label Label2  
         Caption         =   "仓库选择:" 
         Height          =   252 
         Index           =   12 
         Left            =   2880 
         TabIndex        =   31 
         Top             =   720 
         Width           =   1092 
      End 
      Begin VB.Label Label2  
         Caption         =   "入库单号:" 
         Height          =   255 
         Index           =   5 
         Left            =   240 
         TabIndex        =   19 
         Top             =   720 
         Width           =   1095 
      End 
      Begin VB.Label Label2  
         Caption         =   "订货日期:" 
         Height          =   255 
         Index           =   0 
         Left            =   240 
         TabIndex        =   18 
         Top             =   360 
         Width           =   1095 
      End 
      Begin VB.Label Label2  
         Caption         =   "业务员:" 
         Height          =   252 
         Index           =   1 
         Left            =   2880 
         TabIndex        =   17 
         Top             =   360 
         Width           =   1092 
      End 
   End 
   Begin VB.CommandButton cmdExit  
      Caption         =   "返回 (&X)" 
      Height          =   375 
      Left            =   2880 
      TabIndex        =   15 
      Top             =   6720 
      Width           =   1215 
   End 
   Begin VB.CommandButton cmdSave  
      Caption         =   "保存 (&S)" 
      Height          =   375 
      Left            =   1440 
      TabIndex        =   14 
      Top             =   6720 
      Width           =   1215 
   End 
End 
Attribute VB_Name = "frmINH1" 
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 
    Dim mrce As ADODB.Recordset 
     
   
    For intCount = 1 To 7 
        If Trim(txtItem(intCount) & " ") = "" Then 
            Select Case intCount 
                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 
     
'    If Trim(txtItem(11)) = "" Then 
'        MsgBox "请输入型号!", vbOKOnly + vbExclamation, "警告" 
'        txtItem(11).SetFocus 
'        Exit Sub 
'    End If 
     
    If txtItem(8).Visible = True Then 
        If Trim(txtItem(8) & " ") = "" Then 
            sMeg = "预付比例不能为空!" 
            MsgBox sMeg, vbOKOnly + vbExclamation, "警告" 
            txtItem(8).SetFocus 
            Exit Sub 
        End If 
    End If 
 
     
    For intCount = 0 To 2 
        If Trim(Combo1(intCount) & " ") = "" Then 
            Select Case intCount 
                Case 0 
                    sMeg = "业务员" 
                Case 1 
                    sMeg = "供应商名称" 
                Case 2 
                    sMeg = "商品名称" 
            End Select 
            sMeg = sMeg & "不能为空!" 
            MsgBox sMeg, vbOKOnly + vbExclamation, "警告" 
            Combo1(intCount).SetFocus 
            Exit Sub 
        End If 
    Next intCount 
     
    For intCount = 4 To 5 
        If Trim(Combo1(intCount) & " ") = "" Then 
            Select Case intCount 
                Case 4 
                    sMeg = "仓库名称" 
                Case 5 
                    sMeg = "支付方式" 
                     
            End Select 
            sMeg = sMeg & "不能为空!" 
            MsgBox sMeg, vbOKOnly + vbExclamation, "警告" 
            Combo1(intCount).SetFocus 
            Exit Sub 
        End If 
    Next intCount 
     
    For intCount = 4 To 7 
        If Not IsNumeric(Trim(txtItem(intCount))) Then 
            sMeg = "请输入数字!" 
            MsgBox sMeg, vbOKOnly + vbExclamation, "警告" 
            txtItem(intCount).SetFocus 
            Exit Sub 
        End If 
    Next intCount 
     
    If txtItem(8).Visible = True Then 
        If Not IsNumeric(Trim(txtItem(8))) Then 
            sMeg = "预付比例请输入数字!" 
            MsgBox sMeg, vbOKOnly + vbExclamation, "警告" 
            txtItem(8).SetFocus 
            Exit Sub 
        End If 
   End If 
    
    '添加判断是否有相同的ID记录 
    If gintINHmode = 1 Then 
        txtSQL = "select * from inh where inh_no ='" & Trim(txtItem(1)) & "'" 
        Set mrc = ExecuteSQL(txtSQL, MsgText) 
        If mrc.EOF = False Then 
            MsgBox "已经存在此入库单编号的记录!", vbOKOnly + vbExclamation, "警告" 
            txtItem(1).SetFocus 
            Exit Sub 
        End If 
        mrc.Close 
    End If 
     
     
    '先删除已有记录 
    txtSQL = "delete from inh where inh_no ='" & Trim(txtItem(1)) & "'" 
    Set mrc = ExecuteSQL(txtSQL, MsgText) 
    
     
    '再加入新记录 
    txtSQL = "execute inh_setup '" 
     
    txtSQL = txtSQL & Trim(txtItem(0)) & "','" 
     
    txtSQL = txtSQL & Trim(Combo1(0).ItemData(Combo1(0).ListIndex)) & "','" 
     
    For intCount = 1 To 2 
        txtSQL = txtSQL & Trim(txtItem(intCount)) & "','" 
    Next intCount 
     
    txtSQL = txtSQL & Trim(txtItem(10)) & "','" 
     
    txtSQL = txtSQL & Trim(Combo1(2).ItemData(Combo1(2).ListIndex)) & "','" 
     
     
     
    For intCount = 4 To 7 
        txtSQL = txtSQL & Trim(txtItem(intCount)) & "','" 
    Next intCount 
     
    If Combo1(5).ListIndex = 0 Then 
        txtSQL = txtSQL & "Y','N','0','" 
    ElseIf Combo1(5).ListIndex = 1 Then 
        txtSQL = txtSQL & "N','Y','0','" 
    ElseIf Combo1(5).ListIndex = 2 Then 
        txtSQL = txtSQL & "N','N','" & Trim(txtItem(8)) & "','" 
    End If 
     
    txtSQL = txtSQL & Trim(txtItem(9)) & "','" 
     
    txtSQL = txtSQL & Trim(Combo1(3).ItemData(Combo1(3).ListIndex)) & "'" 
     
    Set mrc = ExecuteSQL(txtSQL, MsgText) 
         
    If gintINHmode = 1 Then 
        MsgBox "添加记录成功!", vbOKOnly + vbExclamation, "添加记录" 
         
        txtSQL = "select update_date,sl,total_je from kucun where ckdm = '" & txtItem(10) & "'" 
        txtSQL = txtSQL & " and wzdm = '" & txtItem(3) & "'" 
        txtSQL = txtSQL & " and s_w = '" & Trim(Combo1(3).ItemData(Combo1(3).ListIndex)) & "'" 
 
         
        Set mrc = ExecuteSQL(txtSQL, MsgText) 
         
        If Not mrc.EOF Then 
            mrc.Fields(0) = txtItem(0) 
            mrc.Fields(1) = mrc.Fields(1) + txtItem(4) 
            mrc.Fields(2) = mrc.Fields(2) + txtItem(7) 
            mrc.Update 
             
        Else 
            txtSQL = "execute kucun_setup '" 
            txtSQL = txtSQL & txtItem(0) & "','" 
            txtSQL = txtSQL & GetRkno() & "','" 
            txtSQL = txtSQL & txtItem(10) & "','" 
            txtSQL = txtSQL & Trim(Combo1(2).ItemData(Combo1(2).ListIndex)) & "','" 
            txtSQL = txtSQL & txtItem(4) & "','" 
            txtSQL = txtSQL & txtItem(7) & "','" 
            txtSQL = txtSQL & Trim(Combo1(3).ItemData(Combo1(3).ListIndex)) & "'" 
             
            Set mrce = ExecuteSQL(txtSQL, MsgText) 
             
        End If 
         
        mrc.Close 
         
        For intCount = 0 To 9 
            txtItem(intCount) = "" 
        Next intCount 
         
        For intCount = 0 To 2 
            Combo1(intCount).ListIndex = 0 
        Next intCount 
         
        For intCount = 4 To 5 
            Combo1(intCount).ListIndex = 0 
        Next intCount 
         
 
         
        txtItem(0) = Format(Now, "yyyy-mm-dd") 
         
        mblChange = False 
         
        Unload frmINH 
        frmINH.txtSQL = "select inh_no,in_date,ywman,gfdm,ckdm,wzdm,sl,in_danj,i_zk,i_zke,jsfk,jz,yf,bz,s_w from inh" 
        frmINH.Show 
         
    ElseIf gintINHmode = 2 Then 
         
        txtSQL = "select update_date,sl,total_je from kucun where ckdm = '" & txtCKDM & "'" 
        txtSQL = txtSQL & " and wzdm = '" & txtWZDM & "'" 
        txtSQL = txtSQL & " and s_w = '" & txtQIHAO & "'" 
 
         
        Set mrc = ExecuteSQL(txtSQL, MsgText) 
         
        If Not mrc.EOF Then 
            mrc.Fields(0) = txtItem(0) 
            mrc.Fields(1) = mrc.Fields(1) - txtSL 
            mrc.Fields(2) = mrc.Fields(2) - txtZKE 
            mrc.Update 
        End If 
         
        mrc.Close 
         
        txtSQL = "select update_date,sl,total_je from kucun where ckdm = '" & txtItem(10) & "'" 
        txtSQL = txtSQL & " and wzdm = '" & txtItem(3) & "'" 
        txtSQL = txtSQL & " and s_w = '" & Trim(Combo1(3).ItemData(Combo1(3).ListIndex)) & "'" 
 
         
        Set mrc = ExecuteSQL(txtSQL, MsgText) 
         
        If Not mrc.EOF Then 
            mrc.Fields(0) = txtItem(0) 
            mrc.Fields(1) = mrc.Fields(1) + txtItem(4) 
            mrc.Fields(2) = mrc.Fields(2) + txtItem(7) 
            mrc.Update 
             
        Else 
            txtSQL = "execute kucun_setup '" 
            txtSQL = txtSQL & txtItem(0) & "','" 
            txtSQL = txtSQL & GetRkno() & "','" 
            txtSQL = txtSQL & txtItem(10) & "','" 
            txtSQL = txtSQL & Trim(Combo1(2).ItemData(Combo1(2).ListIndex)) & "','" 
            txtSQL = txtSQL & txtItem(4) & "','" 
            txtSQL = txtSQL & txtItem(7) & "','" 
            txtSQL = txtSQL & Trim(Combo1(3).ItemData(Combo1(3).ListIndex)) & "'" 
             
            Set mrce = ExecuteSQL(txtSQL, MsgText) 
             
        End If 
         
        mrc.Close 
         
        Unload Me 
        Unload frmINH 
 
         
         
        frmINH.txtSQL = "select inh_no,in_date,ywman,gfdm,ckdm,wzdm,sl,in_danj,i_zk,i_zke,jsfk,jz,yf,bz,s_w from inh" 
        frmINH.Show 
    End If 
     
End Sub 
 
Private Sub Combo1_Change(Index As Integer) 
    mblChange = True 
     
     
End Sub 
 
Private Sub Combo1_Click(Index As Integer) 
    Dim mrcc As ADODB.Recordset 
    Dim mrcd As ADODB.Recordset 
    Dim MsgText As String 
     
     
    If Index = 1 Then 
         
        txtItem(2) = Combo1(1).ItemData(Combo1(1).ListIndex) 
    ElseIf Index = 2 Then 
        If Combo1(3).ItemData(Combo1(3).ListIndex) = 0 Then 
            txtSQL = "select dm,rkj  from dm_wz where mc = '" & Trim(Combo1(2)) & "'" 
            Set mrcc = ExecuteSQL(txtSQL, MsgText) 
                         
            If Not mrcc.EOF Then 
                txtItem(3) = mrcc.Fields(0) 
                txtItem(5) = mrcc.Fields(1) 
            End If 
             
            mrcc.Close 
        Else 
            txtSQL = "select mc,rkj  from dm_service where dm = '" & Trim(Combo1(2).ItemData(Combo1(2).ListIndex)) & "'" 
            Set mrcc = ExecuteSQL(txtSQL, MsgText) 
                         
            If Not mrcc.EOF Then 
                txtItem(3) = mrcc.Fields(0) 
                txtItem(5) = mrcc.Fields(1) 
            End If 
             
            mrcc.Close 
        End If 
             
    ElseIf Index = 3 Then 
        Combo1(2).Clear 
        Combo1(2).Enabled = True 
         
        If Combo1(3).ItemData(Combo1(3).ListIndex) = 0 Then '配件 
            txtSQL = "select dm,mc  from dm_wz" 
            Set mrcc = ExecuteSQL(txtSQL, MsgText) 
                         
            Do While Not mrcc.EOF 
                Combo1(2).AddItem mrcc.Fields(1) 
                Combo1(2).ItemData(Combo1(2).NewIndex) = mrcc.Fields(0) 
                mrcc.MoveNext 
            Loop 
             
            mrcc.Close 
         
        ElseIf Combo1(3).ItemData(Combo1(3).ListIndex) = 1 Then 
            txtSQL = "select dm_slb.lb,dm_slb.lb1,dm_service.dm from dm_service inner join dm_slb on dm_service.lbdm = dm_slb.lbcode1" 
            Set mrcc = ExecuteSQL(txtSQL, MsgText) 
                         
            Do While Not mrcc.EOF 
                Combo1(2).AddItem (Trim(mrcc.Fields(0)) + Trim(mrcc.Fields(1))) 
                Combo1(2).ItemData(Combo1(2).NewIndex) = mrcc.Fields(2) 
                mrcc.MoveNext 
            Loop 
             
            mrcc.Close 
         
        End If 
    ElseIf Index = 4 Then 
            txtSQL = "select dm  from dm_ck where mc = '" & Trim(Combo1(4)) & "'" 
            Set mrcc = ExecuteSQL(txtSQL, MsgText) 
                         
            If Not mrcc.EOF Then 
                txtItem(10) = mrcc.Fields(0) 
            End If 
             
            mrcc.Close 
             
    ElseIf Index = 5 Then 
        If Combo1(5).ListIndex = 0 Or Combo1(5).ListIndex = 1 Then 
            txtItem(8).Visible = False 
            Label2(13).Visible = False 
        Else 
            txtItem(8).Visible = True 
            Label2(13).Visible = True 
 
        End If 
    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 
     
    Combo1(5).AddItem "即使付清" 
    Combo1(5).ItemData(Combo1(5).NewIndex) = 0 
    Combo1(5).AddItem "记    账" 
    Combo1(5).ItemData(Combo1(5).NewIndex) = 1 
    Combo1(5).AddItem "预    付" 
    Combo1(5).ItemData(Combo1(5).NewIndex) = 2 
     
    Combo1(3).AddItem "手机及配件" 
    Combo1(3).ItemData(Combo1(3).NewIndex) = 0 
    Combo1(3).AddItem "服      务" 
    Combo1(3).ItemData(Combo1(3).NewIndex) = 1 
     
     
     
     
    txtItem(8).Visible = False 
    Label2(13).Visible = False 
     
   
    If gintINHmode = 1 Then 
        Me.Caption = Me.Caption & "添加" 
        For i = 0 To 10 
            txtItem(i).Text = "" 
        Next i 
         
        For i = 0 To 2 
            Combo1(i).Clear 
        Next i 
         
        For i = 4 To 4 
            Combo1(i).Clear 
        Next i 
         
        Combo1(2).Enabled = False 
         
    ElseIf gintINHmode = 2 Then 
        Set mrc = ExecuteSQL(txtSQL, MsgText) 
         
        If mrc.EOF = False Then 
            With mrc 
                txtItem(0) = .Fields(0) 
                 
                Combo1(0).Clear 
                txtSQL = "select dm,mc from dm_ywy where dm = '" & .Fields(1) & "'" 
                Set mrcc = ExecuteSQL(txtSQL, MsgText) 
                If Not mrcc.EOF Then 
                    Combo1(0).AddItem mrcc.Fields(1) 
                    Combo1(0).ItemData(Combo1(0).NewIndex) = mrcc.Fields(0) 
                    Combo1(0).ListIndex = 0 
                    mrcc.Close 
                End If 
                     
                Combo1(4).Clear 
                txtSQL = "select dm,mc from dm_ck where dm = '" & .Fields(4) & "'" 
                Set mrcc = ExecuteSQL(txtSQL, MsgText) 
                If Not mrcc.EOF Then 
                    Combo1(4).AddItem mrcc.Fields(1) 
                    Combo1(4).ItemData(Combo1(4).NewIndex) = mrcc.Fields(0) 
                    Combo1(4).ListIndex = 0 
                    mrcc.Close 
                End If 
                 
             
                For intCount = 1 To 2 
                    txtItem(intCount) = .Fields(intCount + 1) 
                Next intCount 
                 
                Combo1(1).Clear 
                txtSQL = "select dm,mc from dm_gf where dm = '" & .Fields(3) & "'" 
                Set mrcc = ExecuteSQL(txtSQL, MsgText) 
                If Not mrcc.EOF Then 
                    Combo1(1).AddItem mrcc.Fields(1) 
                    Combo1(1).ItemData(Combo1(1).NewIndex) = mrcc.Fields(0) 
                    Combo1(1).ListIndex = 0 
                    mrcc.Close 
                End If 
                 
                 
                txtItem(3) = .Fields(intCount + 2) 
                 
                If Trim(.Fields(14)) = 0 Then 
                    Combo1(3).ListIndex = 0 
                ElseIf Trim(.Fields(14)) = 1 Then 
                    Combo1(3).ListIndex = 1 
                End If 
                 
                 
                 
                Combo1(2).Clear 
                 
                If Trim(.Fields(14)) = 0 Then 
                     
                    txtSQL = "select dm,mc from dm_wz where dm = '" & .Fields(5) & "'" 
                    Set mrcc = ExecuteSQL(txtSQL, MsgText) 
                    If Not mrcc.EOF Then 
                        Combo1(2).AddItem mrcc.Fields(1) 
                        Combo1(2).ItemData(Combo1(2).NewIndex) = mrcc.Fields(0) 
                        Combo1(2).ListIndex = 0 
                        mrcc.Close 
                    End If 
                ElseIf Trim(.Fields(14)) = 1 Then 
                 
                    txtSQL = "select dm_slb.lb,dm_slb.lb1,dm_service.dm from dm_service inner join dm_slb on dm_service.lbdm = dm_slb.lbcode1 where dm_service.dm = '" & .Fields(5) & "'" 
                    Set mrcc = ExecuteSQL(txtSQL, MsgText) 
                    If Not mrcc.EOF Then 
                        Combo1(2).AddItem Trim(mrcc.Fields(0)) + Trim(mrcc.Fields(1)) 
                        Combo1(2).ItemData(Combo1(2).NewIndex) = mrcc.Fields(2) 
                        Combo1(2).ListIndex = 0 
                        mrcc.Close 
                    End If 
                 
                End If 
                 
                 
                 
                 
                'txtItem(11) = .Fields(6) 
                 
                For intCount = 4 To 7 
                    txtItem(intCount) = .Fields(intCount + 2) 
                Next intCount 
                 
                If Trim(.Fields(10)) = "Y" Then 
                    Combo1(5).ListIndex = 0 
                Else 
                        If Trim(.Fields(11)) = "Y" Then 
                            Combo1(5).ListIndex = 1 
                        Else 
                            Combo1(5).ListIndex = 2 
                            txtItem(8) = .Fields(12) 
                        End If 
                End If 
                 
                txtItem(9) = .Fields(13) 
                 
                 
                 
                txtCKDM = .Fields(4) 
                txtWZDM = .Fields(5) 
                txtSL = .Fields(6) 
                txtZKE = .Fields(9) 
                txtQIHAO = .Fields(14) 
                 
                
            End With 
            txtItem(0).Enabled = False 
        End If 
         
        Me.Caption = Me.Caption & "修改" 
    End If 
     
     
     
    txtSQL = "select dm,mc from dm_ywy" 
    Set mrcc = ExecuteSQL(txtSQL, MsgText) 
     
    If Not mrcc.EOF Then 
        If Trim(Combo1(0)) <> "" Then 
            Do While Not mrcc.EOF 
                If Combo1(0).ItemData(Combo1(0).ListIndex) <> mrcc.Fields(0) Then 
                    Combo1(0).AddItem mrcc.Fields(1) 
                    Combo1(0).ItemData(Combo1(0).NewIndex) = mrcc.Fields(0) 
                End If 
                mrcc.MoveNext 
            Loop 
        Else 
            Do While Not mrcc.EOF 
                Combo1(0).AddItem mrcc.Fields(1) 
                Combo1(0).ItemData(Combo1(0).NewIndex) = mrcc.Fields(0) 
                mrcc.MoveNext 
            Loop 
             
        End If 
    End If 
     
    mrcc.Close 
     
    txtItem(0) = Format(Now, "yyyy-mm-dd") 
    txtItem(0).Enabled = False 
     
    txtSQL = "select dm,mc from dm_gf" 
    Set mrcc = ExecuteSQL(txtSQL, MsgText) 
     
    If Not mrcc.EOF Then 
        If Trim(Combo1(1)) <> "" Then 
            Do While Not mrcc.EOF 
                If Combo1(1).ItemData(Combo1(1).ListIndex) <> mrcc.Fields(0) Then 
                    Combo1(1).AddItem mrcc.Fields(1) 
                    Combo1(1).ItemData(Combo1(1).NewIndex) = mrcc.Fields(0) 
                End If 
                mrcc.MoveNext 
            Loop 
        Else 
            Do While Not mrcc.EOF 
                Combo1(1).AddItem mrcc.Fields(1) 
                Combo1(1).ItemData(Combo1(1).NewIndex) = mrcc.Fields(0) 
                mrcc.MoveNext 
            Loop 
             
        End If 
    End If 
     
    mrcc.Close 
     
    txtSQL = "select dm,mc from dm_wz" 
    Set mrcc = ExecuteSQL(txtSQL, MsgText) 
     
    If Not mrcc.EOF Then 
       If Trim(Combo1(2)) <> "" Then 
          Do While Not mrcc.EOF 
             If Combo1(2).ItemData(Combo1(2).ListIndex) <> mrcc.Fields(0) Then 
                Combo1(2).AddItem mrcc.Fields(1) 
                Combo1(2).ItemData(Combo1(2).NewIndex) = mrcc.Fields(0) 
              End If 
                mrcc.MoveNext 
            Loop 
        Else 
            Do While Not mrcc.EOF 
                Combo1(2).AddItem mrcc.Fields(1) 
                Combo1(2).ItemData(Combo1(2).NewIndex) = mrcc.Fields(0) 
                mrcc.MoveNext 
            Loop 
             
       End If 
    End If 
     
    mrcc.Close 
     
    
    txtSQL = "select dm,mc from dm_ck" 
    Set mrcc = ExecuteSQL(txtSQL, MsgText) 
     
    If Not mrcc.EOF Then 
        If Trim(Combo1(4)) <> "" Then 
            Do While Not mrcc.EOF 
                If Combo1(4).ItemData(Combo1(4).ListIndex) <> mrcc.Fields(0) Then 
                    Combo1(4).AddItem mrcc.Fields(1) 
                    Combo1(4).ItemData(Combo1(4).NewIndex) = mrcc.Fields(0) 
                End If 
                mrcc.MoveNext 
            Loop 
        Else 
            Do While Not mrcc.EOF 
                Combo1(4).AddItem mrcc.Fields(1) 
                Combo1(4).ItemData(Combo1(4).NewIndex) = mrcc.Fields(0) 
                mrcc.MoveNext 
            Loop 
             
        End If 
    End If 
     
    mrcc.Close 
     
     
 
 
     
     
     
     
     
    mblChange = False 
End Sub 
 
Private Sub Form_Unload(Cancel As Integer) 
    gintINHmode = 0 
End Sub 
 
 
 
Private Sub txtItem_Change(Index As Integer) 
    Dim intCount As Integer 
    '用于计算工资 
    Dim dblTotal As Double 
     
   
    '有变化设置gblchange 
    mblChange = True 
     
    If (Index >= 4 And Index <= 6) Then 
        dblTotal = 0 
         
        If Trim(txtItem(4)) <> "" And Trim(txtItem(5)) <> "" And Trim(txtItem(6)) <> "" Then 
            dblTotal = CDbl(txtItem(4)) * CDbl(txtItem(5)) * CDbl(txtItem(6)) / 100 
        End If 
       
        txtItem(7) = Format(dblTotal, "#0.00") 
         
    End If 
             
    Exit Sub 
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 
 
Private Sub txtItem_KeyPress(Index As Integer, KeyAscii As Integer) 
     
    If Index >= 4 And Index <= 6 Then 
        'MsgBox KeyCode 
        '对键入字符进行控制 
        'txtQuantity(Index).Locked = False 
        '小数点只允许输入一次 
        If KeyAscii = 190 Then 
            If InStr(Trim(txtItem(Index)), ".") = 0 Then 
                If Len(Trim(txtItem(Index))) > 0 Then 
                    txtItem(Index).Locked = False 
                Else 
                    txtItem(Index).Locked = True 
                End If 
            Else 
                txtItem(Index).Locked = True 
            End If 
            Exit Sub 
        End If 
        '非数字不能输入 
        If KeyAscii > 57 Or KeyAscii < 48 Then 
            txtItem(Index).Locked = True 
        Else 
            txtItem(Index).Locked = False 
        End If 
        '允许Backspace 
        If KeyAscii = 8 Then 
            txtItem(Index).Locked = False 
        End If 
        'Delete键 
        If KeyAscii = 46 Then 
            txtItem(Index).Locked = False 
        End If 
    End If 
     
     
End Sub