frmbominput.frm

来自「仓库管理软件,库存信息,仓库入库,仓库出库,单据新增,修改,删除,审核,反审核等」· FRM 代码 · 共 302 行

VERSION 5.00
Begin VB.Form frmBomInput 
   BorderStyle     =   3  'Fixed Dialog
   Caption         =   "Form1"
   ClientHeight    =   3165
   ClientLeft      =   45
   ClientTop       =   435
   ClientWidth     =   5865
   LinkTopic       =   "Form1"
   LockControls    =   -1  'True
   MaxButton       =   0   'False
   MDIChild        =   -1  'True
   MinButton       =   0   'False
   ScaleHeight     =   3165
   ScaleWidth      =   5865
   ShowInTaskbar   =   0   'False
   Begin VB.TextBox Text1 
      Height          =   975
      Index           =   4
      Left            =   960
      MultiLine       =   -1  'True
      ScrollBars      =   2  'Vertical
      TabIndex        =   11
      Text            =   "frmBomInput.frx":0000
      Top             =   1290
      Width           =   4455
   End
   Begin VB.CommandButton btnClose 
      Caption         =   "取消"
      Height          =   375
      Left            =   4440
      TabIndex        =   10
      Top             =   2550
      Width           =   975
   End
   Begin VB.CommandButton btnSave 
      Caption         =   "保存"
      Height          =   375
      Left            =   3360
      TabIndex        =   9
      Top             =   2550
      Width           =   975
   End
   Begin VB.CommandButton BtnNew 
      Caption         =   "新增"
      Height          =   375
      Left            =   2280
      TabIndex        =   8
      Top             =   2550
      Width           =   975
   End
   Begin VB.TextBox Text1 
      Height          =   270
      Index           =   3
      Left            =   3600
      TabIndex        =   3
      Text            =   "Text1"
      Top             =   825
      Width           =   1815
   End
   Begin VB.TextBox Text1 
      Height          =   270
      Index           =   2
      Left            =   975
      TabIndex        =   2
      Text            =   "Text1"
      Top             =   840
      Width           =   1815
   End
   Begin VB.TextBox Text1 
      Height          =   270
      Index           =   1
      Left            =   3600
      TabIndex        =   1
      Text            =   "Text1"
      Top             =   360
      Width           =   1815
   End
   Begin VB.TextBox Text1 
      Height          =   270
      Index           =   0
      Left            =   960
      TabIndex        =   0
      Text            =   "Text1"
      Top             =   360
      Width           =   1815
   End
   Begin VB.Label Label5 
      AutoSize        =   -1  'True
      Caption         =   "备注："
      Height          =   180
      Left            =   360
      TabIndex        =   12
      Top             =   1290
      Width           =   540
   End
   Begin VB.Label Label4 
      AutoSize        =   -1  'True
      Caption         =   "数量："
      Height          =   180
      Left            =   3000
      TabIndex        =   7
      Top             =   885
      Width           =   780
   End
   Begin VB.Label Label3 
      AutoSize        =   -1  'True
      Caption         =   "单价："
      Height          =   180
      Left            =   360
      TabIndex        =   6
      Top             =   885
      Width           =   540
   End
   Begin VB.Label Label2 
      AutoSize        =   -1  'True
      Caption         =   "名称："
      Height          =   180
      Left            =   3000
      TabIndex        =   5
      Top             =   405
      Width           =   780
   End
   Begin VB.Label Label1 
      AutoSize        =   -1  'True
      Caption         =   "编码："
      Height          =   180
      Left            =   360
      TabIndex        =   4
      Top             =   405
      Width           =   540
   End
End
Attribute VB_Name = "frmBomInput"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim rstExec As New ADODB.Recordset
Dim mGoodsID As Long
Dim mEdit As Boolean
Dim mSave As Boolean
Dim mchanged As Boolean




Public Sub NewBill()

    Dim i As Long
    For i = 0 To 4
        Text1(i).Text = ""
    Next
    Text1(0).SetFocus
    
    mEdit = False
    mGoodsID = 0
    mchanged = False
End Sub

Public Sub EditBill(ByVal GoodsID As Long)

        If rstExec.State = 1 Then rstExec.Close
        Set rstExec = Nothing
        rstExec.CursorLocation = adUseClient
        rstExec.Open "select * from StockInfo where GoodsID=" & GoodsID, con, adOpenStatic, adLockBatchOptimistic
        
        If rstExec.RecordCount < 1 Then
            Message "该物品不存在!"
            Exit Sub
        End If
        
'        IIf IsNull(rstExec.Fields("GoodsCode")), Text1(0).Text = "", Text1(0).Text = rstExec.Fields("GoodsCode")
'        IIf IsNull(rstExec.Fields("GoodsName")), Text1(1).Text = "", Text1(1).Text = rstExec.Fields("GoodsName")
'        IIf IsNull(rstExec.Fields("Price")), Text1(2).Text = "", Text1(2).Text = rstExec.Fields("Price")
'        IIf IsNull(rstExec.Fields("Quantity")), Text1(3).Text = "", Text1(3).Text = rstExec.Fields("Quantity")
'        IIf IsNull(rstExec.Fields("Memo")), Text1(4).Text = "", Text1(4).Text = rstExec.Fields("Memo")
        
        If IsNull(rstExec.Fields("GoodsCode")) Then Text1(0).Text = "" Else Text1(0).Text = rstExec.Fields("GoodsCode")
        If IsNull(rstExec.Fields("GoodsName")) Then Text1(1).Text = "" Else Text1(1).Text = rstExec.Fields("GoodsName")
        If IsNull(rstExec.Fields("Price")) Then Text1(2).Text = "" Else Text1(2).Text = rstExec.Fields("Price")
        If IsNull(rstExec.Fields("Quantity")) Then Text1(3).Text = "" Else Text1(3).Text = rstExec.Fields("Quantity")
        If IsNull(rstExec.Fields("Memo")) Then Text1(4).Text = "" Else Text1(4).Text = rstExec.Fields("Memo")
        
        mEdit = True
        mGoodsID = GoodsID
        mchanged = False
End Sub


Public Function SaveBill() As Boolean
On Error GoTo isErr:
    
    
    
    If Trim(Text1(0).Text) = "" Then
        Message "请输入物品编码!"
        Exit Function
    End If
    
    mSave = False
    If mchanged = False Then Exit Function
    
    If mEdit = False Then
        
        If rstExec.State = 1 Then rstExec.Close
        Set rstExec = Nothing
        rstExec.CursorLocation = adUseClient
        rstExec.Open "select * from StockInfo where GoodsCode='" & Text1(0).Text & "'", con, adOpenStatic, adLockBatchOptimistic
        
        If rstExec.RecordCount > 0 Then
            Message "该物品编码已经存在!"
            Exit Function
        Else
        
            rstExec.AddNew
            rstExec.Fields("GoodsCode") = Text1(0).Text
            rstExec.Fields("GoodsName") = Text1(1).Text
            rstExec.Fields("Price") = Text1(2).Text
            rstExec.Fields("Quantity") = Text1(3).Text
            rstExec.Fields("Sum") = Val(Text1(2).Text) * Val(Text1(3).Text)
            rstExec.Fields("Memo") = Text1(4).Text
            rstExec.UpdateBatch
            
            If rstExec.State = 1 Then rstExec.Close
            Set rstExec = Nothing
            rstExec.CursorLocation = adUseClient
            rstExec.Open "select max(GoodsID) as ID from StockInfo ", con, adOpenStatic, adLockBatchOptimistic
            
            mGoodsID = rstExec.Fields("ID")
    
        End If

    Else
    
        If rstExec.State = 1 Then rstExec.Close
        Set rstExec = Nothing
        rstExec.CursorLocation = adUseClient
        rstExec.Open "select * from StockInfo where GoodsID=" & mGoodsID, con, adOpenStatic, adLockBatchOptimistic
        
        If rstExec.RecordCount < 1 Then
            Message "该物品不存在!"
            Exit Function
        End If
        
        rstExec.Fields("GoodsCode") = Text1(0).Text
        rstExec.Fields("GoodsName") = Text1(1).Text
        rstExec.Fields("Price") = Text1(2).Text
        rstExec.Fields("Quantity") = Text1(3).Text
        rstExec.Fields("Sum") = Val(Text1(2).Text) * Val(Text1(3).Text)
        rstExec.Fields("Memo") = Text1(4).Text
        rstExec.UpdateBatch
        
    End If
    
    mSave = True
    mEdit = True
    mchanged = False
    
    If FindWindow("frmBomExp") = True Then
        frmBomExp.Update
    End If
    Exit Function
    
isErr:
    Message Err.Description

End Function


Private Sub btnNew_Click()
    NewBill
End Sub
Private Sub btnSave_Click()
    SaveBill
End Sub
Private Sub btnClose_Click()
    Unload Me
End Sub

Private Sub Form_Load()
    Me.Icon = frmMain.Icon
    Me.Caption = "仓库资料输入框"
    
End Sub

Private Sub Form_Unload(Cancel As Integer)
    If rstExec.State = 1 Then rstExec.Close
    Set rstExec = Nothing
End Sub

Private Sub Text1_Change(Index As Integer)
    mchanged = True
End Sub

Private Sub Text1_KeyPress(Index As Integer, KeyAscii As Integer)
    If Index = 2 Or Index = 3 Then
        If KeyAscii = 46 Or KeyAscii = 8 Then Exit Sub
        If KeyAscii < 48 Or KeyAscii > 57 Then KeyAscii = 0
    End If
End Sub