www.pudn.com > vb-sql-server.rar > frmXSDH1.frm, change:2003-01-11,size:21700b


VERSION 5.00 
Begin VB.Form frmXSDH1  
   BorderStyle     =   3  'Fixed Dialog 
   Caption         =   "销售订单信息" 
   ClientHeight    =   6720 
   ClientLeft      =   45 
   ClientTop       =   330 
   ClientWidth     =   6225 
   LinkTopic       =   "Form1" 
   MaxButton       =   0   'False 
   MinButton       =   0   'False 
   ScaleHeight     =   6720 
   ScaleWidth      =   6225 
   ShowInTaskbar   =   0   'False 
   StartUpPosition =   1  'CenterOwner 
   Begin VB.Frame Frame1  
      Caption         =   "其它信息:" 
      Height          =   1692 
      Index           =   3 
      Left            =   120 
      TabIndex        =   26 
      Top             =   4440 
      Width           =   6012 
      Begin VB.TextBox txtItem  
         Height          =   1320 
         Index           =   8 
         Left            =   240 
         MaxLength       =   200 
         MultiLine       =   -1  'True 
         ScrollBars      =   2  'Vertical 
         TabIndex        =   28 
         Top             =   240 
         Width           =   5532 
      End 
   End 
   Begin VB.Frame Frame1  
      Caption         =   "商品信息:" 
      Height          =   1935 
      Index           =   2 
      Left            =   120 
      TabIndex        =   20 
      Top             =   2400 
      Width           =   6012 
      Begin VB.TextBox txtItem  
         Height          =   270 
         Index           =   9 
         Left            =   1080 
         MaxLength       =   20 
         TabIndex        =   29 
         Top             =   720 
         Width           =   1572 
      End 
      Begin VB.TextBox txtItem  
         Height          =   276 
         Index           =   7 
         Left            =   1080 
         MaxLength       =   200 
         MultiLine       =   -1  'True 
         TabIndex        =   10 
         Top             =   1440 
         Width           =   1575 
      End 
      Begin VB.TextBox txtItem  
         Enabled         =   0   'False 
         Height          =   270 
         Index           =   6 
         Left            =   3720 
         MaxLength       =   20 
         TabIndex        =   9 
         Top             =   1080 
         Width           =   2055 
      End 
      Begin VB.TextBox txtItem  
         Enabled         =   0   'False 
         Height          =   270 
         Index           =   5 
         Left            =   1080 
         MaxLength       =   20 
         TabIndex        =   8 
         Top             =   1080 
         Width           =   1575 
      End 
      Begin VB.TextBox txtItem  
         Height          =   270 
         Index           =   4 
         Left            =   3720 
         MaxLength       =   20 
         TabIndex        =   7 
         Top             =   720 
         Width           =   2055 
      End 
      Begin VB.TextBox txtItem  
         Height          =   270 
         Index           =   3 
         Left            =   1080 
         MaxLength       =   20 
         TabIndex        =   5 
         Top             =   360 
         Width           =   1572 
      End 
      Begin VB.ComboBox Combo1  
         Height          =   288 
         Index           =   2 
         Left            =   3720 
         Style           =   2  'Dropdown List 
         TabIndex        =   6 
         Top             =   360 
         Width           =   2052 
      End 
      Begin VB.Label Label2  
         Caption         =   "期       号:" 
         Height          =   255 
         Index           =   3 
         Left            =   240 
         TabIndex        =   30 
         Top             =   720 
         Width           =   1095 
      End 
      Begin VB.Label Label2  
         Caption         =   "订货金额:" 
         Height          =   255 
         Index           =   6 
         Left            =   240 
         TabIndex        =   27 
         Top             =   1440 
         Width           =   1095 
      End 
      Begin VB.Label Label2  
         Caption         =   "折扣比例:" 
         Height          =   255 
         Index           =   2 
         Left            =   2880 
         TabIndex        =   25 
         Top             =   1080 
         Width           =   1095 
      End 
      Begin VB.Label Label2  
         Caption         =   "订货单价:" 
         Height          =   255 
         Index           =   11 
         Left            =   240 
         TabIndex        =   24 
         Top             =   1080 
         Width           =   1095 
      End 
      Begin VB.Label Label2  
         Caption         =   "数       量:" 
         Height          =   255 
         Index           =   10 
         Left            =   2880 
         TabIndex        =   23 
         Top             =   720 
         Width           =   1095 
      End 
      Begin VB.Label Label2  
         Caption         =   "商品代码:" 
         Height          =   255 
         Index           =   9 
         Left            =   240 
         TabIndex        =   22 
         Top             =   360 
         Width           =   1095 
      End 
      Begin VB.Label Label2  
         Caption         =   "商品名称:" 
         Height          =   252 
         Index           =   8 
         Left            =   2880 
         TabIndex        =   21 
         Top             =   360 
         Width           =   1092 
      End 
   End 
   Begin VB.Frame Frame1  
      Caption         =   "客户信息:" 
      Height          =   852 
      Index           =   1 
      Left            =   120 
      TabIndex        =   17 
      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        =   19 
         Top             =   360 
         Width           =   1092 
      End 
      Begin VB.Label Label2  
         Caption         =   "客户代码:" 
         Height          =   255 
         Index           =   4 
         Left            =   240 
         TabIndex        =   18 
         Top             =   360 
         Width           =   1095 
      End 
   End 
   Begin VB.Frame Frame1  
      Caption         =   "订单基本信息:" 
      Height          =   1212 
      Index           =   0 
      Left            =   120 
      TabIndex        =   13 
      Top             =   120 
      Width           =   6012 
      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           =   5 
         Left            =   360 
         TabIndex        =   16 
         Top             =   720 
         Width           =   1092 
      End 
      Begin VB.Label Label2  
         Caption         =   "订货日期:" 
         Height          =   252 
         Index           =   0 
         Left            =   360 
         TabIndex        =   15 
         Top             =   360 
         Width           =   1092 
      End 
      Begin VB.Label Label2  
         Caption         =   "业务员:" 
         Height          =   252 
         Index           =   1 
         Left            =   2880 
         TabIndex        =   14 
         Top             =   360 
         Width           =   1092 
      End 
   End 
   Begin VB.CommandButton cmdExit  
      Caption         =   "返回 (&X)" 
      Height          =   375 
      Left            =   3000 
      TabIndex        =   12 
      Top             =   6240 
      Width           =   1215 
   End 
   Begin VB.CommandButton cmdSave  
      Caption         =   "保存 (&S)" 
      Height          =   375 
      Left            =   1560 
      TabIndex        =   11 
      Top             =   6240 
      Width           =   1215 
   End 
End 
Attribute VB_Name = "frmXSDH1" 
Attribute VB_GlobalNameSpace = False 
Attribute VB_Creatable = False 
Attribute VB_PredeclaredId = True 
Attribute VB_Exposed = False 
Option Explicit 
'是否改动过记录,ture为改过 
Dim mblChange As Boolean 
Dim mrc As ADODB.Recordset 
Public txtSQL As String 
 
Private Sub cmdExit_Click() 
    If mblChange And cmdSave.Enabled Then 
        If MsgBox("保存当前记录的变化吗?", vbOKCancel + vbExclamation, "警告") = vbOK Then 
            '保存 
            Call cmdSave_Click 
        End If 
    End If 
    Unload Me 
End Sub 
 
Private Sub cmdSave_Click() 
    Dim intCount As Integer 
    Dim sMeg As String 
    Dim MsgText As String 
     
   
    For intCount = 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(9)) = "" Then 
        MsgBox "请指定该种商品的期号!", vbOKOnly + vbExclamation, "警告" 
        txtItem(9).SetFocus 
        Exit Sub 
    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 7 
        If Not IsNumeric(Trim(txtItem(intCount))) Then 
            sMeg = "请输入数字!" 
            MsgBox sMeg, vbOKOnly + vbExclamation, "警告" 
            txtItem(intCount).SetFocus 
            Exit Sub 
        End If 
    Next intCount 
    
    '添加判断是否有相同的ID记录 
    If gintXSDHmode = 1 Then 
        txtSQL = "select * from xsdh where xsdh_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 xsdh where xsdh_no ='" & Trim(txtItem(1)) & "'" 
    Set mrc = ExecuteSQL(txtSQL, MsgText) 
    
     
    '再加入新记录 
    txtSQL = "execute xsdh_setup '" 
     
    txtSQL = txtSQL & Trim(txtItem(0)) & "','" 
     
    txtSQL = txtSQL & Trim(Combo1(0).ItemData(Combo1(0).ListIndex)) & "','" 
     
    For intCount = 1 To 3 
        txtSQL = txtSQL & Trim(txtItem(intCount)) & "','" 
    Next intCount 
     
    txtSQL = txtSQL & Trim(txtItem(9)) & "','" 
     
    For intCount = 4 To 7 
        txtSQL = txtSQL & Trim(txtItem(intCount)) & "','" 
    Next intCount 
     
     
    txtSQL = txtSQL & Trim(txtItem(8)) & "'" 
     
     
    Set mrc = ExecuteSQL(txtSQL, MsgText) 
         
    If gintXSDHmode = 1 Then 
        MsgBox "添加记录成功!", vbOKOnly + vbExclamation, "添加记录" 
        For intCount = 0 To 9 
            txtItem(intCount) = "" 
        Next intCount 
         
        For intCount = 0 To 2 
            Combo1(intCount).ListIndex = 0 
        Next intCount 
        
         
        txtItem(0) = Format(Now, "yyyy-mm-dd") 
         
        mblChange = False 
         
        Unload frmXSDH 
        frmXSDH.txtSQL = "select xsdh_no,out_date,ywman,khdm,wzdm,qihao,sl,out_danj,o_zk,o_zke,bz from xsdh" 
        frmXSDH.Show 
         
    ElseIf gintXSDHmode = 2 Then 
        Unload Me 
        Unload frmXSDH 
         
        frmXSDH.txtSQL = "select xsdh_no,out_date,ywman,khdm,wzdm,qihao,sl,out_danj,o_zk,o_zke,bz from xsdh" 
        frmXSDH.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) 
         
        txtSQL = "select mb_reb from dm_kh where dm = '" & Trim(txtItem(2)) & "'" 
        Set mrcc = ExecuteSQL(txtSQL, MsgText) 
        If Not mrcc.EOF Then 
            txtItem(6) = mrcc.Fields(0) 
            mrcc.Close 
        End If 
  
    ElseIf Index = 2 Then 
            txtSQL = "select dm,lsj  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 
             
    End If 
 
End Sub 
 
Private Sub Form_Load() 
    Dim intCount As Integer 
    Dim MsgText As String 
    Dim i As Integer 
    Dim mrcc As ADODB.Recordset 
   
    If gintXSDHmode = 1 Then 
        Me.Caption = Me.Caption & "添加" 
        For i = 0 To 8 
            txtItem(i).Text = "" 
        Next i 
         
        For i = 0 To 2 
            Combo1(i).Clear 
        Next i 
         
         
         
    ElseIf gintXSDHmode = 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 
             
                For intCount = 1 To 3 
                    txtItem(intCount) = .Fields(intCount + 1) 
                Next intCount 
                 
                txtItem(9) = .Fields(5) 
                 
                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 
                 
                Combo1(2).Clear 
                txtSQL = "select dm,mc from dm_wz where dm = '" & .Fields(4) & "'" 
                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 
                 
                For intCount = 4 To 8 
                    txtItem(intCount) = .Fields(intCount + 2) 
                Next intCount 
                
            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 
     
     
     
    mblChange = False 
End Sub 
 
Private Sub Form_Unload(Cancel As Integer) 
    gintXSDHmode = 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 <= 5) 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 
            txtItem(7) = Format(dblTotal, "#0.00") 
        End If 
       
         
    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