www.pudn.com > vb-sql-server.rar > frmOUTH1.frm, change:2003-01-12,size:35004b


VERSION 5.00 
Begin VB.Form frmOUTH1  
   Caption         =   "销售单信息" 
   ClientHeight    =   6945 
   ClientLeft      =   5445 
   ClientTop       =   2640 
   ClientWidth     =   6315 
   LinkTopic       =   "Form1" 
   ScaleHeight     =   6945 
   ScaleWidth      =   6315 
   Begin VB.TextBox txtQIHAO  
      Height          =   372 
      Left            =   240 
      TabIndex        =   42 
      Text            =   "txtSL" 
      Top             =   6600 
      Visible         =   0   'False 
      Width           =   252 
   End 
   Begin VB.TextBox txtSL  
      Height          =   372 
      Left            =   4560 
      TabIndex        =   41 
      Text            =   "txtSL" 
      Top             =   6480 
      Visible         =   0   'False 
      Width           =   252 
   End 
   Begin VB.TextBox txtZKE  
      Height          =   372 
      Left            =   5520 
      TabIndex        =   40 
      Text            =   "Text2" 
      Top             =   6480 
      Visible         =   0   'False 
      Width           =   252 
   End 
   Begin VB.TextBox txtWZDM  
      Height          =   372 
      Left            =   5880 
      TabIndex        =   39 
      Text            =   "txtSL" 
      Top             =   6480 
      Visible         =   0   'False 
      Width           =   252 
   End 
   Begin VB.TextBox txtYANSE  
      Height          =   372 
      Left            =   4920 
      TabIndex        =   38 
      Text            =   "txtSL" 
      Top             =   6480 
      Visible         =   0   'False 
      Width           =   252 
   End 
   Begin VB.TextBox txtCKDM  
      Height          =   372 
      Left            =   1080 
      TabIndex        =   37 
      Text            =   "txtSL" 
      Top             =   6480 
      Visible         =   0   'False 
      Width           =   252 
   End 
   Begin VB.CommandButton cmdSave  
      Caption         =   "保存 (&S)" 
      Height          =   375 
      Left            =   1560 
      TabIndex        =   36 
      Top             =   6480 
      Width           =   1215 
   End 
   Begin VB.CommandButton cmdExit  
      Caption         =   "返回 (&X)" 
      Height          =   375 
      Left            =   3000 
      TabIndex        =   35 
      Top             =   6480 
      Width           =   1215 
   End 
   Begin VB.Frame Frame1  
      Caption         =   "销售单基本信息:" 
      Height          =   1212 
      Index           =   0 
      Left            =   120 
      TabIndex        =   26 
      Top             =   0 
      Width           =   6012 
      Begin VB.TextBox txtItem  
         Height          =   270 
         Index           =   0 
         Left            =   1080 
         MaxLength       =   20 
         TabIndex        =   30 
         Top             =   360 
         Width           =   1572 
      End 
      Begin VB.ComboBox Combo1  
         Height          =   288 
         Index           =   0 
         Left            =   3720 
         Style           =   2  'Dropdown List 
         TabIndex        =   29 
         Top             =   360 
         Width           =   2052 
      End 
      Begin VB.TextBox txtItem  
         Height          =   270 
         Index           =   1 
         Left            =   1080 
         MaxLength       =   20 
         TabIndex        =   28 
         Top             =   720 
         Width           =   1572 
      End 
      Begin VB.ComboBox Combo1  
         Height          =   288 
         Index           =   4 
         Left            =   3720 
         Style           =   2  'Dropdown List 
         TabIndex        =   27 
         Top             =   720 
         Width           =   2052 
      End 
      Begin VB.Label Label2  
         Caption         =   "业务员:" 
         Height          =   252 
         Index           =   1 
         Left            =   2880 
         TabIndex        =   34 
         Top             =   360 
         Width           =   1092 
      End 
      Begin VB.Label Label2  
         Caption         =   "销售日期:" 
         Height          =   255 
         Index           =   0 
         Left            =   240 
         TabIndex        =   33 
         Top             =   360 
         Width           =   1095 
      End 
      Begin VB.Label Label2  
         Caption         =   "销售单号:" 
         Height          =   255 
         Index           =   5 
         Left            =   240 
         TabIndex        =   32 
         Top             =   720 
         Width           =   1095 
      End 
      Begin VB.Label Label2  
         Caption         =   "提货仓库:" 
         Height          =   252 
         Index           =   12 
         Left            =   2880 
         TabIndex        =   31 
         Top             =   720 
         Width           =   1092 
      End 
   End 
   Begin VB.Frame Frame1  
      Caption         =   "客户信息:" 
      Height          =   852 
      Index           =   1 
      Left            =   120 
      TabIndex        =   21 
      Top             =   1320 
      Width           =   6012 
      Begin VB.ComboBox Combo1  
         Height          =   288 
         Index           =   1 
         Left            =   3720 
         Style           =   2  'Dropdown List 
         TabIndex        =   23 
         Top             =   360 
         Width           =   2052 
      End 
      Begin VB.TextBox txtItem  
         Height          =   270 
         Index           =   2 
         Left            =   1080 
         MaxLength       =   20 
         TabIndex        =   22 
         Top             =   360 
         Width           =   1572 
      End 
      Begin VB.Label Label2  
         Caption         =   "客户代码:" 
         Height          =   255 
         Index           =   4 
         Left            =   240 
         TabIndex        =   25 
         Top             =   360 
         Width           =   1095 
      End 
      Begin VB.Label Label2  
         Caption         =   "客户名称:" 
         Height          =   252 
         Index           =   7 
         Left            =   2880 
         TabIndex        =   24 
         Top             =   360 
         Width           =   1092 
      End 
   End 
   Begin VB.Frame Frame1  
      Caption         =   "商品信息:" 
      Height          =   1815 
      Index           =   2 
      Left            =   120 
      TabIndex        =   8 
      Top             =   2280 
      Width           =   6012 
      Begin VB.TextBox txtItem  
         Enabled         =   0   'False 
         Height          =   270 
         Index           =   11 
         Left            =   1080 
         MaxLength       =   20 
         TabIndex        =   43 
         Top             =   720 
         Width           =   1572 
      End 
      Begin VB.ComboBox Combo1  
         Height          =   288 
         Index           =   2 
         Left            =   3720 
         Style           =   2  'Dropdown List 
         TabIndex        =   14 
         Top             =   360 
         Width           =   2052 
      End 
      Begin VB.TextBox txtItem  
         Enabled         =   0   'False 
         Height          =   270 
         Index           =   3 
         Left            =   1080 
         MaxLength       =   20 
         TabIndex        =   13 
         Top             =   360 
         Width           =   1572 
      End 
      Begin VB.TextBox txtItem  
         Height          =   270 
         Index           =   4 
         Left            =   3720 
         MaxLength       =   20 
         TabIndex        =   12 
         Top             =   720 
         Width           =   2055 
      End 
      Begin VB.TextBox txtItem  
         Enabled         =   0   'False 
         Height          =   270 
         Index           =   5 
         Left            =   1080 
         MaxLength       =   20 
         TabIndex        =   11 
         Top             =   1080 
         Width           =   1575 
      End 
      Begin VB.TextBox txtItem  
         Enabled         =   0   'False 
         Height          =   270 
         Index           =   6 
         Left            =   3720 
         MaxLength       =   20 
         TabIndex        =   10 
         Top             =   1080 
         Width           =   2055 
      End 
      Begin VB.TextBox txtItem  
         Enabled         =   0   'False 
         Height          =   276 
         Index           =   7 
         Left            =   1080 
         MaxLength       =   200 
         MultiLine       =   -1  'True 
         TabIndex        =   9 
         Top             =   1440 
         Width           =   1575 
      End 
      Begin VB.Label Label2  
         Caption         =   "期       号:" 
         Height          =   255 
         Index           =   3 
         Left            =   240 
         TabIndex        =   44 
         Top             =   720 
         Width           =   1095 
      End 
      Begin VB.Label Label2  
         Caption         =   "商品名称:" 
         Height          =   252 
         Index           =   8 
         Left            =   2880 
         TabIndex        =   20 
         Top             =   360 
         Width           =   1092 
      End 
      Begin VB.Label Label2  
         Caption         =   "商品代码:" 
         Height          =   255 
         Index           =   9 
         Left            =   240 
         TabIndex        =   19 
         Top             =   360 
         Width           =   1095 
      End 
      Begin VB.Label Label2  
         Caption         =   "数       量:" 
         Height          =   255 
         Index           =   10 
         Left            =   2880 
         TabIndex        =   18 
         Top             =   720 
         Width           =   1095 
      End 
      Begin VB.Label Label2  
         Caption         =   "销售单价:" 
         Height          =   255 
         Index           =   11 
         Left            =   240 
         TabIndex        =   17 
         Top             =   1080 
         Width           =   1095 
      End 
      Begin VB.Label Label2  
         Caption         =   "折扣比例:" 
         Height          =   255 
         Index           =   2 
         Left            =   2880 
         TabIndex        =   16 
         Top             =   1080 
         Width           =   1095 
      End 
      Begin VB.Label Label2  
         Caption         =   "销售金额:" 
         Height          =   255 
         Index           =   6 
         Left            =   240 
         TabIndex        =   15 
         Top             =   1440 
         Width           =   1095 
      End 
   End 
   Begin VB.Frame Frame1  
      Caption         =   "其它信息:" 
      Height          =   1452 
      Index           =   3 
      Left            =   120 
      TabIndex        =   6 
      Top             =   4920 
      Width           =   6012 
      Begin VB.TextBox txtItem  
         Height          =   1080 
         Index           =   9 
         Left            =   360 
         MaxLength       =   200 
         MultiLine       =   -1  'True 
         ScrollBars      =   2  'Vertical 
         TabIndex        =   7 
         Top             =   240 
         Width           =   5412 
      End 
   End 
   Begin VB.Frame Frame1  
      Caption         =   "支付方式:" 
      Height          =   612 
      Index           =   4 
      Left            =   120 
      TabIndex        =   1 
      Top             =   4200 
      Width           =   6012 
      Begin VB.ComboBox Combo1  
         Height          =   288 
         Index           =   5 
         Left            =   1080 
         Style           =   2  'Dropdown List 
         TabIndex        =   3 
         Top             =   240 
         Width           =   1572 
      End 
      Begin VB.TextBox txtItem  
         Height          =   276 
         Index           =   8 
         Left            =   3720 
         MaxLength       =   200 
         MultiLine       =   -1  'True 
         TabIndex        =   2 
         Top             =   240 
         Width           =   2052 
      End 
      Begin VB.Label Label2  
         Caption         =   "预付比例:" 
         Height          =   252 
         Index           =   13 
         Left            =   2880 
         TabIndex        =   5 
         Top             =   240 
         Width           =   1092 
      End 
      Begin VB.Label Label2  
         Caption         =   "方式选择:" 
         Height          =   252 
         Index           =   14 
         Left            =   360 
         TabIndex        =   4 
         Top             =   240 
         Width           =   1092 
      End 
   End 
   Begin VB.TextBox txtItem  
      Height          =   276 
      Index           =   10 
      Left            =   600 
      MaxLength       =   200 
      MultiLine       =   -1  'True 
      TabIndex        =   0 
      Top             =   6600 
      Visible         =   0   'False 
      Width           =   492 
   End 
End 
Attribute VB_Name = "frmOUTH1" 
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 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 gintOUTHmode = 1 Then 
        txtSQL = "select * from outh where outh_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 
     
    If gintOUTHmode = 1 Then 
        txtSQL = "select update_date,sl,total_je from kucun where ckdm = '" & txtItem(10) & "'" 
        txtSQL = txtSQL & " and wzdm = '" & txtItem(3) & "'" 
        txtSQL = txtSQL & " and qihao = '" & txtItem(11) & "'" 
         
        Set mrc = ExecuteSQL(txtSQL, MsgText) 
         
        If Not mrc.EOF Then 
            If mrc.Fields(1) >= CDbl(txtItem(4)) Then 
                mrc.Fields(0) = txtItem(0) 
                mrc.Fields(1) = mrc.Fields(1) - txtItem(4) 
                mrc.Fields(2) = mrc.Fields(2) * (mrc.Fields(1)) / (mrc.Fields(1) + txtItem(4)) 
                mrc.Update 
                mrc.Close 
            Else 
                mrc.Close 
                sMeg = "库存商品数量不够,请首先从其他仓库调拨!" 
                MsgBox sMeg, vbOKOnly + vbExclamation, "警告" 
                Exit Sub 
            End If 
        Else 
                sMeg = "仓库没有指定商品数量不够,请首先从其他仓库调拨!" 
                MsgBox sMeg, vbOKOnly + vbExclamation, "警告" 
                Exit Sub 
        End If 
         
    ElseIf gintOUTHmode = 2 Then 
        If (txtCKDM = txtItem(10)) And (txtWZDM = txtItem(3)) And (txtQIHAO = txtItem(11)) Then 
            txtSQL = "select update_date,sl,total_je from kucun where ckdm = '" & txtCKDM & "'" 
            txtSQL = txtSQL & " and wzdm = '" & txtWZDM & "'" 
            txtSQL = txtSQL & " and qihao = '" & txtQIHAO & "'" 
             
            Set mrc = ExecuteSQL(txtSQL, MsgText) 
             
            If Not mrc.EOF Then 
                If (mrc.Fields(1) + CDbl(txtSL)) >= CDbl(txtItem(4)) Then 
                    mrc.Fields(0) = txtItem(0) 
                    mrc.Fields(1) = mrc.Fields(1) + txtSL - txtItem(4) 
                    mrc.Fields(2) = mrc.Fields(2) * (mrc.Fields(1)) / (mrc.Fields(1) - txtSL + txtItem(4)) 
                    mrc.Update 
                    mrc.Close 
                Else 
                    mrc.Close 
                    sMeg = "库存商品数量不够,请首先从其他仓库调拨!" 
                    MsgBox sMeg, vbOKOnly + vbExclamation, "警告" 
                    Exit Sub 
                End If 
            Else 
                sMeg = "仓库中没有指定商品,请首先从其他仓库调拨!" 
                MsgBox sMeg, vbOKOnly + vbExclamation, "警告" 
                Exit Sub 
            End If 
             
        Else 
            txtSQL = "select update_date,sl,total_je from kucun where ckdm = '" & txtItem(10) & "'" 
            txtSQL = txtSQL & " and wzdm = '" & txtItem(3) & "'" 
            txtSQL = txtSQL & " and qihao = '" & txtItem(11) & "'" 
 
             
            Set mrc = ExecuteSQL(txtSQL, MsgText) 
             
            If Not mrc.EOF Then 
                If mrc.Fields(1) >= CDbl(txtItem(4)) Then 
                    mrc.Fields(0) = txtItem(0) 
                    mrc.Fields(1) = mrc.Fields(1) - txtItem(4) 
                    mrc.Fields(2) = mrc.Fields(2) * (mrc.Fields(1)) / (mrc.Fields(1) + txtItem(4)) 
                    mrc.Update 
                    mrc.Close 
                Else 
                    mrc.Close 
                    sMeg = "库存商品数量不够,请首先从其他仓库调拨!" 
                    MsgBox sMeg, vbOKOnly + vbExclamation, "警告" 
                    Exit Sub 
                End If 
            Else 
                    sMeg = "仓库没有指定商品,请首先从其他仓库调拨!" 
                    MsgBox sMeg, vbOKOnly + vbExclamation, "警告" 
                    Exit Sub 
            End If 
             
            txtSQL = "select update_date,sl,total_je from kucun where ckdm = '" & txtCKDM & "'" 
            txtSQL = txtSQL & " and wzdm = '" & txtWZDM & "'" 
            txtSQL = txtSQL & " and qihao = '" & 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) * (mrc.Fields(1)) / (mrc.Fields(1) - txtSL) 
                    mrc.Update 
            End If 
             
            mrc.Close 
        End If 
     
    End If 
     
     
     
    '先删除已有记录 
    txtSQL = "delete from outh where outh_no ='" & Trim(txtItem(1)) & "'" 
    Set mrc = ExecuteSQL(txtSQL, MsgText) 
    
     
    '再加入新记录 
    txtSQL = "execute outh_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(txtItem(3)) & "','" 
     
    txtSQL = txtSQL & Trim(txtItem(11)) & "','" 
     
    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)) & "'" 
     
     
    Set mrc = ExecuteSQL(txtSQL, MsgText) 
         
    If gintOUTHmode = 1 Then 
         
        MsgBox "添加记录成功!", vbOKOnly + vbExclamation, "添加记录" 
         
         
        For intCount = 0 To 9 
            txtItem(intCount) = "" 
        Next intCount 
         
        txtItem(11) = "" 
         
        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 frmOUTH 
        frmOUTH.txtSQL = "select outh_no,out_date,ywman,khdm,ckdm,wzdm,qihao,sl,out_danj,o_zk,o_zke,jsfk,jz,yf,bz from outh" 
        frmOUTH.Show 
         
    ElseIf gintOUTHmode = 2 Then 
        Unload Me 
        Unload frmOUTH 
         
        frmOUTH.txtSQL = "select outh_no,out_date,ywman,khdm,ckdm,wzdm,qihao,sl,out_danj,o_zk,o_zke,jsfk,jz,yf,bz from outh" 
        frmOUTH.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 
         
            txtSQL = "select dm,mb_reb  from dm_kh where mc = '" & Trim(Combo1(1)) & "'" 
            Set mrcc = ExecuteSQL(txtSQL, MsgText) 
                         
            If Not mrcc.EOF Then 
                txtItem(2) = mrcc.Fields(0) 
                txtItem(6) = mrcc.Fields(1) 
            End If 
             
            mrcc.Close 
 
    ElseIf Index = 2 Then 
                txtSQL = "select kucun.wzdm,kucun.qihao,dm_wz.lsj  from kucun inner join  dm_wz on kucun.wzdm = dm_wz.dm  where kucun.wzdm = '" & Trim(Combo1(2).ItemData(Combo1(2).ListIndex)) & "'" 
                Set mrcc = ExecuteSQL(txtSQL, MsgText) 
                             
                If Not mrcc.EOF Then 
                    txtItem(3) = mrcc.Fields(0) 
                    txtItem(11) = mrcc.Fields(1) 
                    txtItem(5) = mrcc.Fields(2) 
                End If 
                 
                mrcc.Close 
    ElseIf Index = 4 Then 
            txtItem(10) = Combo1(4).ItemData(Combo1(4).ListIndex) 
             
            Combo1(2).Clear 
             
            txtSQL = "select dm_wz.dm,dm_wz.mc  from kucun inner join dm_wz on kucun.wzdm = dm_wz.dm where kucun.ckdm = '" & Trim(txtItem(10)) & "'" 
            Set mrcc = ExecuteSQL(txtSQL, MsgText) 
             
            If Not mrcc.EOF Then 
                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 
            End If 
                     
                 
             
    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 
     
    txtItem(8).Visible = False 
    Label2(13).Visible = False 
 
   
    If gintOUTHmode = 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 
         
         
    ElseIf gintOUTHmode = 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_kh 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) 
                 
                Combo1(2).Clear 
                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 
                 
                txtItem(11) = .Fields(6) 
                 
                For intCount = 4 To 7 
                    txtItem(intCount) = .Fields(intCount + 3) 
                Next intCount 
                 
                If Trim(.Fields(11)) = "Y" Then 
                    Combo1(5).ListIndex = 0 
                Else 
                        If Trim(.Fields(12)) = "Y" Then 
                            Combo1(5).ListIndex = 1 
                        Else 
                            Combo1(5).ListIndex = 2 
                            txtItem(8) = .Fields(13) 
                        End If 
                End If 
                 
                txtItem(9) = .Fields(14) 
                 
                txtCKDM = .Fields(4) 
                txtWZDM = .Fields(5) 
                txtQIHAO = .Fields(6) 
                txtSL = .Fields(7) 
                txtZKE = .Fields(10) 
                 
                 
                
            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_kh" 
    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) 
    gintOUTHmode = 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