www.pudn.com > vb-sql-server.rar > frmWX1.frm, change:2003-12-02,size:22126b


VERSION 5.00 
Begin VB.Form frmWX1  
   BorderStyle     =   3  'Fixed Dialog 
   Caption         =   "销售单商品信息" 
   ClientHeight    =   3012 
   ClientLeft      =   48 
   ClientTop       =   336 
   ClientWidth     =   5616 
   LinkTopic       =   "Form1" 
   MaxButton       =   0   'False 
   MinButton       =   0   'False 
   ScaleHeight     =   3012 
   ScaleWidth      =   5616 
   ShowInTaskbar   =   0   'False 
   StartUpPosition =   1  'CenterOwner 
   Begin VB.Frame Frame1  
      Caption         =   "商品信息:" 
      Height          =   2292 
      Index           =   2 
      Left            =   120 
      TabIndex        =   4 
      Top             =   120 
      Width           =   5412 
      Begin VB.ComboBox Combo1  
         Height          =   288 
         Index           =   2 
         Left            =   1080 
         Style           =   2  'Dropdown List 
         TabIndex        =   18 
         Top             =   720 
         Width           =   1572 
      End 
      Begin VB.ComboBox Combo1  
         Height          =   288 
         Index           =   1 
         Left            =   1080 
         Style           =   2  'Dropdown List 
         TabIndex        =   17 
         Top             =   1080 
         Width           =   4212 
      End 
      Begin VB.TextBox txtItem  
         Enabled         =   0   'False 
         Height          =   270 
         Index           =   2 
         Left            =   1080 
         MaxLength       =   20 
         TabIndex        =   14 
         Top             =   1440 
         Width           =   1572 
      End 
      Begin VB.TextBox txtItem  
         Height          =   270 
         Index           =   1 
         Left            =   3720 
         MaxLength       =   20 
         TabIndex        =   13 
         Top             =   720 
         Width           =   1572 
      End 
      Begin VB.TextBox txtItem  
         Height          =   270 
         Index           =   0 
         Left            =   1080 
         MaxLength       =   20 
         TabIndex        =   12 
         Top             =   360 
         Width           =   1572 
      End 
      Begin VB.ComboBox Combo1  
         Height          =   288 
         Index           =   0 
         Left            =   3720 
         Style           =   2  'Dropdown List 
         TabIndex        =   11 
         Top             =   360 
         Width           =   1572 
      End 
      Begin VB.TextBox txtItem  
         Height          =   270 
         Index           =   4 
         Left            =   1080 
         MaxLength       =   20 
         TabIndex        =   1 
         Top             =   1800 
         Width           =   1572 
      End 
      Begin VB.TextBox txtItem  
         Height          =   270 
         Index           =   3 
         Left            =   3720 
         MaxLength       =   20 
         TabIndex        =   0 
         Top             =   1440 
         Width           =   1572 
      End 
      Begin VB.Label Label2  
         Caption         =   "总  金  额:" 
         Height          =   252 
         Index           =   1 
         Left            =   360 
         TabIndex        =   16 
         Top             =   1800 
         Width           =   1092 
      End 
      Begin VB.Label Label2  
         Caption         =   "数       量:" 
         Height          =   252 
         Index           =   0 
         Left            =   2880 
         TabIndex        =   15 
         Top             =   1440 
         Width           =   1092 
      End 
      Begin VB.Label Label2  
         Caption         =   "单        价:" 
         Height          =   252 
         Index           =   2 
         Left            =   360 
         TabIndex        =   10 
         Top             =   1440 
         Width           =   1092 
      End 
      Begin VB.Label Label2  
         Caption         =   "型       号:" 
         Height          =   252 
         Index           =   11 
         Left            =   360 
         TabIndex        =   9 
         Top             =   720 
         Width           =   1092 
      End 
      Begin VB.Label Label2  
         Caption         =   "商品名称:" 
         Height          =   252 
         Index           =   10 
         Left            =   360 
         TabIndex        =   8 
         Top             =   1080 
         Width           =   1092 
      End 
      Begin VB.Label Label2  
         Caption         =   "仓库编号:" 
         Height          =   252 
         Index           =   9 
         Left            =   360 
         TabIndex        =   7 
         Top             =   360 
         Width           =   1092 
      End 
      Begin VB.Label Label2  
         Caption         =   "仓库名称:" 
         Height          =   252 
         Index           =   8 
         Left            =   2880 
         TabIndex        =   6 
         Top             =   360 
         Width           =   1092 
      End 
      Begin VB.Label Label2  
         Caption         =   "商品编号:" 
         Height          =   252 
         Index           =   3 
         Left            =   2880 
         TabIndex        =   5 
         Top             =   720 
         Width           =   1092 
      End 
   End 
   Begin VB.CommandButton cmdExit  
      Caption         =   "返回 (&X)" 
      Height          =   375 
      Left            =   3000 
      TabIndex        =   3 
      Top             =   2520 
      Width           =   1215 
   End 
   Begin VB.CommandButton cmdSave  
      Caption         =   "保存 (&S)" 
      Height          =   375 
      Left            =   1560 
      TabIndex        =   2 
      Top             =   2520 
      Width           =   1215 
   End 
End 
Attribute VB_Name = "frmWX1" 
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 txtM_NO As String ' 
Public txtM_DATE As String ' 
Public txtKHDM As String ' 
Public txtYWDM As String ' 
Public txtREB As Integer 
Public txtLXDH As String 
Public txtCKDM As String 
Public txtWZDM As String 
Public txtS_W As String 
Public txtSL As String 
Public txtZKE 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 4 
        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 = "总金额" 
            End Select 
            sMeg = sMeg & "不能为空!" 
            MsgBox sMeg, vbOKOnly + vbExclamation, "警告" 
            txtItem(intCount).SetFocus 
            Exit Sub 
        End If 
    Next intCount 
     
    
    '添加判断是否有相同的ID记录 
    If gintPLmode = 1 Then 
        txtSQL = "select * from outh where outh_no ='" & Trim(txtM_NO) & "' and wzdm = '" & Trim(txtItem(1)) & "' and ckdm = '" & Trim(txtItem(0)) & "' and s_w = '" & Trim(Combo1(2).ItemData(Combo1(2).ListIndex)) & "'" 
        Set mrc = ExecuteSQL(txtSQL, MsgText) 
        If mrc.EOF = False Then 
            MsgBox "已经存在相同商品!", vbOKOnly + vbExclamation, "警告" 
            Combo1(0).SetFocus 
            mrc.Close 
            Exit Sub 
        End If 
    End If 
     
     
    If gintPLmode = 1 Then 
        txtSQL = "select update_date,sl,total_je from kucun where ckdm = '" & txtItem(0) & "'" 
        txtSQL = txtSQL & " and wzdm = '" & txtItem(1) & "'" 
        txtSQL = txtSQL & " and s_w = '" & Trim(Combo1(2).ItemData(Combo1(2).ListIndex)) & "'" 
         
        Set mrc = ExecuteSQL(txtSQL, MsgText) 
         
        If Not mrc.EOF Then 
            If mrc.Fields(1) < CDbl(txtItem(3)) Then 
                mrc.Close 
                sMeg = "库存商品数量不够,请首先从其他仓库调拨!" 
                MsgBox sMeg, vbOKOnly + vbExclamation, "警告" 
                Exit Sub 
            End If 
        Else 
                sMeg = "仓库没有指定商品,请首先从其他仓库调拨!" 
                MsgBox sMeg, vbOKOnly + vbExclamation, "警告" 
                Exit Sub 
        End If 
    ElseIf gintPLmode = 2 Then 
        If (Trim(txtCKDM) = Trim(txtItem(0))) And (Trim(txtWZDM) = Trim(txtItem(1))) Then 
            txtSQL = "select update_date,sl,total_je from kucun where ckdm = '" & txtCKDM & "'" 
            txtSQL = txtSQL & " and wzdm = '" & txtWZDM & "'" 
            txtSQL = txtSQL & " and s_w = '" & txtS_W & "'" 
             
            Set mrc = ExecuteSQL(txtSQL, MsgText) 
             
            If Not mrc.EOF Then 
                If (mrc.Fields(1) + CDbl(txtSL)) >= CDbl(txtItem(3).Text) Then 
                    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(0) & "'" 
            txtSQL = txtSQL & " and wzdm = '" & txtItem(1) & "'" 
            txtSQL = txtSQL & " and s_w = '" & Trim(Combo1(2).ItemData(Combo1(2).ListIndex)) & "'" 
             
            Set mrc = ExecuteSQL(txtSQL, MsgText) 
             
            If Not mrc.EOF Then 
                If mrc.Fields(1) >= CDbl(txtItem(3)) Then 
                    mrc.Close 
                Else 
                    mrc.Close 
                    sMeg = "库存商品数量不够,请首先从其他仓库调拨!" 
                    MsgBox sMeg, vbOKOnly + vbExclamation, "警告" 
                    Exit Sub 
                End If 
            Else 
                    sMeg = "仓库没有指定商品,请首先从其他仓库调拨!" 
                    MsgBox sMeg, vbOKOnly + vbExclamation, "警告" 
                    Exit Sub 
            End If 
             
        End If 
    End If 
     
     
     
    '先删除已有记录 
    txtSQL = "delete from outh where outh_no ='" & Trim(txtM_NO) & "' and wzdm = '" & Trim(txtWZDM) & "' and ckdm = '" & Trim(txtCKDM) & "' and s_w = '" & Trim(txtS_W) & "'" 
    Set mrc = ExecuteSQL(txtSQL, MsgText) 
    
     
    '再加入新记录 
    txtSQL = "insert outh (out_date,ywman,outh_no,khmc,lxdh,ckdm,wzdm,out_danj,sl,o_zke,o_zk,bz1,s_w) values ('" 
     
    txtSQL = txtSQL & Trim(txtM_DATE) & "','" 
     
    txtSQL = txtSQL & Trim(txtYWDM) & "','" 
    txtSQL = txtSQL & Trim(txtM_NO) & "','" 
     
 
     
    txtSQL = txtSQL & Trim(txtKHDM) & "','" 
    txtSQL = txtSQL & Trim(txtLXDH) & "','" 
     
    For intCount = 0 To 4 
        txtSQL = txtSQL & Trim(txtItem(intCount)) & "','" 
    Next intCount 
     
    txtSQL = txtSQL & Trim(txtREB) & "','" 
    txtSQL = txtSQL & "N','" 
    txtSQL = txtSQL & Trim(Combo1(2).ItemData(Combo1(2).ListIndex)) & "')" 
     
     
     
    Set mrc = ExecuteSQL(txtSQL, MsgText) 
         
    If gintPLmode = 1 Then 
        MsgBox "添加记录成功!", vbOKOnly + vbExclamation, "添加记录" 
        For intCount = 0 To 4 
            txtItem(intCount) = "" 
        Next intCount 
         
        For intCount = 0 To 1 
'            Combo1(intCount).ListIndex = 0 
        Next intCount 
         
        mblChange = False 
         
        gintPLLISTmode = 2 
        If Trim(Combo1(2).ItemData(Combo1(2).ListIndex)) = 0 Then 
            frmWX.txtSQL = "select outh.outh_no,dm_wz.dm,dm_wz.mc,dm_ck.mc,outh.sl,outh.out_danj,outh.o_zk,outh.o_zke,outh.s_w from outh inner join dm_wz on outh.wzdm = dm_wz.dm inner join dm_ck on outh.ckdm = dm_ck.dm where outh_no = '" & txtM_NO & "'" 
        ElseIf Trim(Combo1(2).ItemData(Combo1(2).ListIndex)) = 1 Then 
            frmWX.txtSQL = "select outh.outh_no,dm_service.dm,dm_service.mc,dm_ck.mc,outh.sl,outh.out_danj,outh.o_zk,outh.o_zke,outh.s_w from outh inner join dm_service on outh.wzdm = dm_service.dm inner join dm_ck on outh.ckdm = dm_ck.dm where outh_no = '" & txtM_NO & "'" 
        End If 
         
        Unload frmWX1 
        frmWX.ShowData 
         
    ElseIf gintPLmode = 2 Then 
        If Trim(Combo1(2).ItemData(Combo1(2).ListIndex)) = 0 Then 
            frmWX.txtSQL = "select outh.outh_no,dm_wz.dm,dm_wz.mc,dm_ck.mc,outh.sl,outh.out_danj,outh.o_zk,outh.o_zke,outh.s_w from outh inner join dm_wz on outh.wzdm = dm_wz.dm inner join dm_ck on outh.ckdm = dm_ck.dm where outh_no = '" & txtM_NO & "'" 
        ElseIf Trim(Combo1(2).ItemData(Combo1(2).ListIndex)) = 1 Then 
            frmWX.txtSQL = "select outh.outh_no,dm_service.dm,dm_service.mc,dm_ck.mc,outh.sl,outh.out_danj,outh.o_zk,outh.o_zke,outh.s_w from outh inner join dm_service on outh.wzdm = dm_service.dm inner join dm_ck on outh.ckdm = dm_ck.dm where outh_no = '" & txtM_NO & "'" 
        End If 
 
        Unload frmWX1 
        frmWX.ShowData 
    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 = 0 Then 
            txtItem(0) = Combo1(0).ItemData(Combo1(0).ListIndex) 
             
            Combo1(1).Clear 
             
'            txtSQL = "select dm_wz.dm,dm_wz.mc from kucun inner join dm_wz on kucun.wzdm = dm_wz.dm inner join dm_wzlb on dm_wz.lbdm = dm_wzlb.lbcode1 inner join dm_kh on dm_kh.lbdm = dm_wzlb.lb1 inner join dm_ck on kucun.ckdm = dm_ck.dm where dm_wzlb.lb1 = '" & Trim(txtLB) & "'" 
'            txtSQL = txtSQL & " and dm_ck.dm = '" & Trim(Combo1(0).ItemData(Combo1(0).ListIndex)) & "'" 
'            Set mrcc = ExecuteSQL(txtSQL, MsgText) 
                         
'            If Not mrcc.EOF Then 
'                Do While Not mrcc.EOF 
'                    If Trim(mrcc.Fields(1)) <> Trim(Combo1(1)) Then 
'                        Combo1(1).AddItem mrcc.Fields(1) 
'                        Combo1(1).ItemData(Combo1(1).NewIndex) = mrcc.Fields(0) 
'                    End If 
                     
'                    mrcc.MoveNext 
'                Loop 
'                mrcc.Close 
'            Else 
'                MsgBox "指定仓库中没有相应车型的配件,请进货!", vbOKOnly + vbExclamation, "警告" 
                 
'            End If 
    ElseIf Index = 1 Then 
        txtItem(2).Text = "" 
        txtItem(1) = Combo1(1).ItemData(Combo1(1).ListIndex) 
         
        If Trim(Combo1(2).ItemData(Combo1(2).ListIndex)) = 0 Then 
            txtSQL = "select dm_wz.lsj from kucun inner join dm_wz on kucun.wzdm = dm_wz.dm where kucun.ckdm = '" & Trim(txtItem(0)) & "'" 
            txtSQL = txtSQL & " and kucun.wzdm = '" & Trim(txtItem(1)) & "' and kucun.s_w = '" & Trim(Combo1(2).ItemData(Combo1(2).ListIndex)) & "'" 
        ElseIf Trim(Combo1(2).ItemData(Combo1(2).ListIndex)) = 1 Then 
            txtSQL = "select dm_service.lsj from kucun inner join dm_service on kucun.wzdm = dm_service.dm where kucun.ckdm = '" & Trim(txtItem(0)) & "'" 
            txtSQL = txtSQL & " and kucun.wzdm = '" & Trim(txtItem(1)) & "' and kucun.s_w = '" & Trim(Combo1(2).ItemData(Combo1(2).ListIndex)) & "'" 
        End If 
         
        Set mrcc = ExecuteSQL(txtSQL, MsgText) 
         
        If Not mrcc.EOF Then 
            txtItem(2) = mrcc.Fields(0) 
            'txtItem(3) = mrcc.Fields(1) 
            mrcc.Close 
        End If 
    ElseIf Index = 2 Then 
        Combo1(1).Clear 
        Combo1(1).Enabled = True 
         
        If Trim(Combo1(0)) = "" Then 
            MsgBox "请先选择仓库!", vbOKOnly + vbExclamation, "警告" 
        Else 
            If Combo1(2).ItemData(Combo1(2).ListIndex) = 0 Then '配件 
                txtSQL = "select dm,mc  from dm_wz" 
                Set mrcc = ExecuteSQL(txtSQL, MsgText) 
                             
                Do While Not mrcc.EOF 
                    Combo1(1).AddItem mrcc.Fields(1) 
                    Combo1(1).ItemData(Combo1(1).NewIndex) = mrcc.Fields(0) 
                    mrcc.MoveNext 
                Loop 
                 
                mrcc.Close 
             
            ElseIf Combo1(2).ItemData(Combo1(2).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(1).AddItem (Trim(mrcc.Fields(0)) + Trim(mrcc.Fields(1))) 
                    Combo1(1).ItemData(Combo1(1).NewIndex) = mrcc.Fields(2) 
                    mrcc.MoveNext 
                Loop 
                 
                mrcc.Close 
            End If 
        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(0).Clear 
   
    Combo1(2).AddItem "手机及配件" 
    Combo1(2).ItemData(Combo1(2).NewIndex) = 0 
    Combo1(2).AddItem "服      务" 
    Combo1(2).ItemData(Combo1(2).NewIndex) = 1 
 
   
    If gintPLmode = 1 Then 
        Me.Caption = Me.Caption & "添加" 
        For i = 0 To 4 
            txtItem(i).Text = "" 
        Next i 
         
        Combo1(0).Clear 
         
        Combo1(1).Enabled = False 
         
    ElseIf gintPLmode = 2 Then 
        Set mrc = ExecuteSQL(txtSQL, MsgText) 
         
  'dm_ck.dm,dm_ck.mc,dm_wz.dm,dm_wz.mc,outh.s_w,outh.out_danj,outh.sl,outh.o_zke 
         
        If mrc.EOF = False Then 
            With mrc 
                txtItem(0) = .Fields(0) 
                txtCKDM = .Fields(0) 
                 
                Combo1(0).Clear 
                Combo1(0).AddItem .Fields(1) 
                Combo1(0).ItemData(Combo1(0).NewIndex) = .Fields(0) 
                Combo1(0).ListIndex = 0 
                 
                txtItem(1) = .Fields(2) 
                txtWZDM = .Fields(2) 
                 
 
                If Trim(txtS_W) = 0 Then 
                    Combo1(2).ListIndex = 0 
                ElseIf Trim(txtS_W) = 1 Then 
                    Combo1(2).ListIndex = 1 
                End If 
                 
                 
                For intCount = 2 To 4 
                    txtItem(intCount) = .Fields(intCount + 3) 
                Next intCount 
                 
                Combo1(1).ListIndex = Trim(txtItem(1)) - 1 
                 
                'txtQIHAO = .Fields(4) 
                txtSL = .Fields(6) 
                txtZKE = .Fields(7) 
                 
            End With 
            txtItem(0).Enabled = False 
        End If 
         
        Me.Caption = Me.Caption & "修改" 
    End If 
     
     
         
    txtSQL = "select dm,mc from dm_ck" 
    Set mrcc = ExecuteSQL(txtSQL, MsgText) 
     
    If Not mrcc.EOF Then 
        Do While Not mrcc.EOF 
            If Trim(mrcc.Fields(1)) <> Trim(Combo1(0)) Then 
                Combo1(0).AddItem mrcc.Fields(1) 
                Combo1(0).ItemData(Combo1(0).NewIndex) = mrcc.Fields(0) 
            End If 
                 
            mrcc.MoveNext 
        Loop 
    End If 
     
    mrcc.Close 
     
    mblChange = False 
End Sub 
 
Private Sub Form_Unload(Cancel As Integer) 
    gintDHmode = 0 
End Sub 
 
 
 
Private Sub txtItem_Change(Index As Integer) 
    Dim intCount As Integer 
    '用于计算工资 
    Dim dblTotal As Double 
     
   
    '有变化设置gblchange 
    mblChange = True 
     
    If (Index = 3) Then 
        dblTotal = 0 
         
        If Trim(txtItem(3)) <> "" Then 
            dblTotal = CDbl(txtItem(2)) * CDbl(txtItem(3)) * txtREB / 100 
        End If 
       
        txtItem(4) = 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 <= 4 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