frmthwh.frm

以前写的一个销售的管理系统,是牙刷销存管理系统,有销售,进货等功能,刚学ＶＢ时写的

         Top             =   3360
         Width           =   1575
      End
      Begin VB.Label Label9 
         Caption         =   "总 金 额:"
         BeginProperty Font 
            Name            =   "宋体"
            Size            =   14.25
            Charset         =   134
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         ForeColor       =   &H00FF0000&
         Height          =   375
         Left            =   5640
         TabIndex        =   19
         Top             =   3360
         Width           =   1695
      End
      Begin VB.Label Label7 
         Caption         =   "备    注:"
         BeginProperty Font 
            Name            =   "宋体"
            Size            =   14.25
            Charset         =   134
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         ForeColor       =   &H00FF0000&
         Height          =   495
         Left            =   360
         TabIndex        =   18
         Top             =   4200
         Width           =   1455
      End
      Begin VB.Label Label5 
         Caption         =   "单    价:"
         BeginProperty Font 
            Name            =   "宋体"
            Size            =   14.25
            Charset         =   134
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         ForeColor       =   &H00FF0000&
         Height          =   495
         Left            =   5640
         TabIndex        =   17
         Top             =   2520
         Width           =   1695
      End
      Begin VB.Label Label3 
         Caption         =   "产品编号："
         BeginProperty Font 
            Name            =   "宋体"
            Size            =   14.25
            Charset         =   134
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         ForeColor       =   &H00FF0000&
         Height          =   615
         Left            =   5640
         TabIndex        =   16
         Top             =   840
         Width           =   1455
      End
      Begin VB.Label Label2 
         Caption         =   "单    位："
         BeginProperty Font 
            Name            =   "宋体"
            Size            =   14.25
            Charset         =   134
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         ForeColor       =   &H00FF0000&
         Height          =   495
         Left            =   360
         TabIndex        =   15
         Top             =   2520
         Width           =   1455
      End
      Begin VB.Label Label1 
         Caption         =   "退货单编号:"
         BeginProperty Font 
            Name            =   "宋体"
            Size            =   14.25
            Charset         =   134
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         ForeColor       =   &H00FF0000&
         Height          =   495
         Left            =   360
         TabIndex        =   14
         Top             =   840
         Width           =   1695
      End
   End
   Begin VB.Label Label8 
      Caption         =   "操 作 员:"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   14.25
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H00FF0000&
      Height          =   375
      Left            =   8040
      TabIndex        =   23
      Top             =   7560
      Width           =   1575
   End
End
Attribute VB_Name = "frmthwh"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Sub Command1_Click()
  txtth.Enabled = True
  txtth.Locked = False
  txtcp.Enabled = True
  txtdw.Enabled = True
  txtdj.Enabled = True
  txtquan.Enabled = True
  txtname.Enabled = True
  txtname.Locked = True
  txtzje.Enabled = True
  txtbz.Enabled = True
  txtkh.Enabled = True
  txtdate.Enabled = True
  Command1.Enabled = False
  Command2.Enabled = True
  txtth.SetFocus
End Sub

Private Sub Command2_Click()
  DefaultType = dbUseODBC
  Dim db As Database
  Dim rs As Recordset
  Dim cx As Boolean
  Dim str As String
  str = "select * from fdk2002 where [发货]=false"
  cx = False
  Set db = OpenDatabase("xsys", dbDriverNoPrompt, False, "odbc;database=glxt;uid=;pwd=;dsn=xsys")
  Set rs = db.OpenRecordset(str, dbOpenDynaset, dbwrite, dbOptimistic)
  If txtth.Text = "" Then
     If MsgBox("退货单编号不能为空,请重新输入!", vbOKCancel, "错误") = vbOK Then
        Command3.SetFocus
     Else
        Command3.SetFocus
     End If
  Else
     rs.MoveFirst
     Do While rs.EOF <> True
        If rs.Fields("发货单编号") = LTrim(txtth.Text) Then
           cx = True
           Exit Do
        Else
           rs.MoveNext
        End If
     Loop
     If MsgBox("请确认填写无误,否则修改!", vbOKCancel, "提示") = vbOK Then
        If cx = True Then
           With rs
                .Edit
                .Fields("单价") = CCur(LTrim(txtdj.Text))
                .Fields("总金额") = -CCur(LTrim(txtdj.Text) * CLng(Trim(txtquan.Text)))
                .Fields("备注") = LTrim(txtbz.Text)
                .Update
           End With
           txtth.Text = ""
           txtcp.Text = ""
           txtdw.Text = ""
           txtdj.Text = ""
           txtquan.Text = ""
           txtkh.Text = ""
           txtname.Text = ""
           txtname.Enabled = False
           txtzje.Text = ""
           txtbz.Text = ""
           txtdate.Text = ""
           Command2.Enabled = False
           Command1.Enabled = True
           txtth.Enabled = False
           txtkh.Enabled = False
           txtcp.Enabled = False
           txtdw.Enabled = False
           txtdj.Enabled = False
           txtquan.Enabled = False
           txtzje.Enabled = False
           txtbz.Enabled = False
           txtdate.Enabled = False
        Else
           MsgBox "此发货单编号不存在,请重新输入!", vbCritical, "错误"
           txtth.Text = ""
           txtth.SetFocus
        End If
    Else
        txtth.SetFocus
    End If
     rs.Close
     db.Close
  End If
End Sub

Private Sub Command3_Click()
  Unload Me
  frmmenu.Show
End Sub

Private Sub Form_KeyPress(KeyAscii As Integer)
  Dim nexttabindex As Integer, i As Integer
       If KeyAscii = 13 Then
          If Screen.ActiveControl.TabIndex = Count - 1 Then
             nexttabindex = 0
          Else
             nexttabindex = Screen.ActiveControl.TabIndex + 1
          End If
          For i = 0 To Count - 1
              If Me.Controls(i).TabIndex = nexttabindex Then
                 Me.Controls(i).SetFocus
                 Exit For
              End If
              If nexttabindex = 10 Then
                 Command2.SetFocus
                 Exit For
              End If
          Next i
          KeyAscii = 0
        End If
End Sub

Private Sub Form_Load()
  txtth.Enabled = False
  txtcp.Enabled = False
  txtdw.Enabled = False
  txtdj.Enabled = False
  txtquan.Enabled = False
  txtname.Enabled = False
  txtzje.Enabled = False
  txtbz.Enabled = False
  txtkh.Enabled = False
  txtdate.Enabled = False
  txtczy.Text = frmlogin.Combo1.Text
  txtczy.Locked = True
  Command2.Enabled = False
End Sub

Private Sub txtth_LostFocus()
  On Error GoTo a
  DefaultType = dbUseODBC
  Dim db As Database
  Dim rs As Recordset
  Dim str As String
  Dim cx As Boolean
  cx = False
  str = "select * from fdk2002 where [发货]=false"
  Set db = OpenDatabase("xsys", dbDriverNoPrompt, False, "odbc;database=glxt;uid=;pwd=;dsn=xsys")
  Set rs = db.OpenRecordset(str, dbOpenDynaset, dbwrite, dbOptimistic)
  If txtth.Text = "" Then
     If MsgBox("退货单编号不能为空,请重新输入!", vbOKCancel, "错误") = vbOK Then
        Command3.SetFocus
     Else
        Command3.SetFocus
     End If
  Else
     rs.MoveFirst
     Do While rs.EOF <> True
        If rs.Fields("发货单编号") = LTrim(txtth.Text) Then
           cx = True
           Exit Do
        Else
           rs.MoveNext
        End If
     Loop
     If cx = True Then
        txtname.Locked = False
        txtcp.Text = rs.Fields("产品编号")
        txtdw.Text = rs.Fields("单位")
        txtdj.Text = rs.Fields("单价")
        txtquan.Text = rs.Fields("数量")
        txtzje.Text = -(rs.Fields("总金额"))
        txtbz.Text = rs.Fields("备注")
        txtdate.Text = rs.Fields("发货单日期")
        txtkh.Text = rs.Fields("客户编号")
        txtname.Text = rs.Fields("单位名称")
        txtname.Locked = True
        txtth.Locked = True
        txtcp.Locked = True
        txtkh.Locked = True
        txtdw.Locked = True
        txtquan.Locked = True
        txtzje.Locked = True
        txtdate.Locked = True
     Else
        MsgBox "此退货单号不存在,请重新输入!", vbCritical, "错误"
        txtth.Text = ""
        txtcp.SetFocus
     End If
  End If
  rs.Close
  db.Close
a:
  If Err.Number = 94 Then
     txtdw.SetFocus
  End If
End Sub
Private Sub txtzje_GotFocus()
  txtzje.Text = CCur(CCur(txtdj.Text) * CInt(txtquan.Text))
End Sub