frmshipmentssubinfo.frm

企业ERP系统 采用VB+SQL2000实现。 有客户合约

            Left            =   4380
            TabIndex        =   12
            Top             =   780
            Width           =   1035
         End
         Begin VB.Label Label3 
            Caption         =   "描述"
            Height          =   315
            Left            =   4380
            TabIndex        =   11
            Top             =   1560
            Width           =   855
         End
         Begin VB.Label Label4 
            Caption         =   "出貨數量"
            Height          =   315
            Left            =   360
            TabIndex        =   10
            Top             =   2460
            Width           =   1035
         End
         Begin VB.Label Label5 
            Caption         =   "疋數"
            Height          =   315
            Left            =   4380
            TabIndex        =   9
            Top             =   2400
            Width           =   915
         End
         Begin VB.Label Label6 
            Caption         =   "單位"
            Height          =   315
            Left            =   360
            TabIndex        =   8
            Top             =   2880
            Width           =   915
         End
         Begin VB.Label Label7 
            Caption         =   "裝倉期"
            Height          =   315
            Left            =   4380
            TabIndex        =   7
            Top             =   2880
            Width           =   915
         End
      End
   End
End
Attribute VB_Name = "frmShipmentsSubInfo"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Public newItem As Boolean 'true表示增加
Public CustomerNo As String
Private Sub ActiveBar21_ToolClick(ByVal Tool As ActiveBar2LibraryCtl.Tool)
    Select Case Tool.Name
            Case "cmdSave":
                 Save newItem
           Case "cmdCancel":
                Unload Me
            Case "cmdDel":
                DelOperatorInf
    End Select
End Sub

Private Sub CmdFabric_Click()
    frmFabricSelect.Show vbModal
    GetFabricInfo frmFabricSelect.FabricCode
End Sub
Private Sub GetFabricInfo(FabricNo As String)
        Dim rs As ADODB.Recordset
    On Error GoTo errLabel
    Set rs = New ADODB.Recordset
    With rs
      .CursorLocation = adUseClient
      .CursorType = adOpenDynamic
      .LockType = adLockOptimistic
      Set .ActiveConnection = Cn
    End With
    rs.Open "select * from tBasicProduct where FabricCode=" & objDatabase.FormatSQL(FabricNo)
        If Not rs.EOF Then
            ComFabricNo = NullValue(rs.Fields!FabricCode)
            ComFabricName = NullValue(rs.Fields!FabricName)
            txtComposition = NullValue(rs.Fields!Composition)
        End If
    rs.Close

remClear:
    Set rs = Nothing
    Exit Sub
errLabel:
    objDatabase.DatabaseError
    GoTo remClear
End Sub

Private Sub cmdOk_Click()
    frmShipmentsSubInfoSelect.CustomerNo = CustomerNo
    frmShipmentsSubInfoSelect.Show vbModal
End Sub

Private Sub Form_Load()
    Me.Move (Screen.Width - Me.Width) \ 2, (Screen.Height - Me.Height) \ 2
    Initcbb ComUnit, "UnitName", "tBasicUnit"
    InitColorLayout ColorLayout, "tBasicColorLayout"
    InitTitle
End Sub
Private Sub InitTitle()
    Label1.Caption = "裝貨編號"
    Label2.item(0).Caption = "加工單號"
    Label2.item(1).Caption = "加工廠單號"
    Label2.item(2).Caption = "布號"
    Label2.item(6).Caption = "布名"
    Label2.item(5).Caption = "組織"
    Label2.item(9).Caption = "顏色花型"
    'Label2.item(8).Caption = "英文顏色花型"
    Label2.item(12).Caption = "交期"
    Label3.Caption = "描述"
    Label4.Caption = "出貨數量"
    Label5.Caption = "疋數"
    Label6.Caption = "單位"
    Label7.Caption = "裝倉期"
    Label12.Caption = "船開期"
    Label13.Caption = "包裝"
    Label14.Caption = "庫存數"
    Label15.Caption = "客人"
    Me.Caption = "出貨通知明細"
End Sub
Private Sub DelOperatorInf()
    Dim strSql As String
    On Error GoTo errHandle
    If MsgBox("确定要刪除？", vbQuestion + vbYesNo, "询问") = vbNo Then
        Exit Sub
    Else
        strSql = "delete from  tShipmentsNoticesSub where id=" & txtId
        objDatabase.ExecCmd strSql
        MsgBox "刪除成功!", vbInformation, "提示"
    End If
        frmShipmentsInfo.FillMshf1 ("select * from tShipmentsNoticesSub")
        Unload Me
    Exit Sub
errHandle:
   objDatabase.DatabaseError
    
End Sub
Public Sub InitInfo(strId As String, strNoticesNo As String)
    If newItem = False Then
    Dim rs As ADODB.Recordset
      SystemExecuteStart Me
     ' On Error GoTo errLabel
      Set rs = New ADODB.Recordset
      With rs
        .CursorLocation = adUseClient
        .CursorType = adOpenDynamic
        .LockType = adLockOptimistic
        Set .ActiveConnection = Cn
      End With
      Dim strSql As String
        strSql = "select * from tShipmentsNoticesSub where id=" & strId
        rs.Open strSql
        If Not rs.EOF Then
            txtNoticesNo = rs.Fields!NoticesNo
            txtNoticesNo.Enabled = False
            txtOrderNo = rs.Fields!OrderNo
            txtOrderNo.Enabled = False
            txtFactoryNo = rs.Fields!FactoryNo
            ComFabricNo = rs.Fields!FabricNo
            ComFabricName = rs.Fields!FabricName
            txtComposition = rs.Fields!Composition
            ColorLayout = rs.Fields!eLayoutColor
           ' txteLayoutColor = rs.Fields!elayoutcolor
            Delivery = rs.Fields!Delivery
            txtDescription = rs.Fields!Description
            txtQuantity = rs.Fields!Quantity
            txtClothAmount = rs.Fields!clothamount
            ComUnit = rs.Fields!unit
            Stockdate = rs.Fields!Stockdate
            Shipmentsdate = rs.Fields!Shipmentsdate
            txtPacking = rs.Fields!Packing
            txtStockAmount = rs.Fields!StockAmount
            txtCustomerName = rs.Fields!CustomerName
            txtId = rs.Fields("id")
        End If
        rs.Close
      Set rs = Nothing
      SystemExecuteEnd Me
Exit Sub
End If
errLabel:
    SystemExecuteEnd Me
    objDatabase.DatabaseError
End Sub
Private Sub spModiNotices(ByVal spOrderNo As String, ByVal spQuantity As Integer, ByVal spNoticesNo As String, ByVal spFlag As Boolean)
Dim mycomm As ADODB.Command
Set mycomm = New ADODB.Command
With mycomm
    .ActiveConnection = Cn
    .CommandText = "pModiNotices"
    .CommandType = 4
    .Prepared = True
    .Parameters.Append .CreateParameter("@iOrderNo", adVarChar, adParamInput, 20, spOrderNo)
    .Parameters.Append .CreateParameter("@iModiQuantity", adBigInt, adParamInput, 8, spQuantity)
    .Parameters.Append .CreateParameter("@iNoticesNo", adVarChar, adParamInput, 20, spNoticesNo)
    .Parameters.Append .CreateParameter("@iFlag", adBoolean, adParamInput, 1, spFlag)
    .Execute
End With
End Sub
Private Sub Save(Optional blModi As Boolean)
    Dim strSql As String
    Dim rs As ADODB.Recordset
    Set rs = New ADODB.Recordset
    With rs
      .CursorLocation = adUseClient
      .CursorType = adOpenDynamic
      .LockType = adLockOptimistic
      Set .ActiveConnection = Cn
    End With
        On Error GoTo errHandle
        If txtNoticesNo = "" Then
            MsgBox "請填寫裝貨編號", vbCritical, "提示"
            txtOrderNo.SetFocus
            Exit Sub
        End If
        If IsNumeric(txtQuantity) = False Then
            MsgBox "請在碼數上填寫正確格式", vbCritical, "提示"
            txtQuantity.SetFocus
            Exit Sub
        End If
        If IsNumeric(txtClothAmount) = False Then
            MsgBox "請在疋數上填寫正確格式", vbCritical, "提示"
            txtClothAmount.SetFocus
            Exit Sub
        End If
        If blModi Then
        strSql = "select * from tShipmentsNoticesSub"
        rs.Open strSql
            If MsgBox("是否增加？", vbQuestion + vbYesNo, "询问") = vbNo Then
                rs.Close
                Set rs = Nothing
                Exit Sub
            End If
                    
            rs.AddNew '新建
        Else
            strSql = "select * from tShipmentsNoticesSub where id=" & txtId
            rs.Open strSql
            If rs.EOF Then '修改
                MsgBox "没有可修改的信息!", vbExclamation, "修改"
                rs.Close
                Set rs = Nothing
                txtNoticesNo.SetFocus
                Exit Sub
            End If
            If MsgBox("是否修改记录？", vbYesNo + vbQuestion, "修改") = vbNo Then
                rs.Close
                Set rs = Nothing
                Exit Sub
            End If
        End If
        rs.Fields!NoticesNo = txtNoticesNo
        rs.Fields!OrderNo = txtOrderNo
        rs.Fields!FactoryNo = txtFactoryNo
        rs.Fields!FabricNo = ComFabricNo
        rs.Fields!FabricName = ComFabricName
        rs.Fields!Composition = txtComposition
        'rs.Fields!LayoutColor = txtLayoutColor
        rs.Fields!eLayoutColor = ColorLayout
        rs.Fields!Delivery = Delivery
        rs.Fields!Description = txtDescription
        rs.Fields!Quantity = txtQuantity
        rs.Fields!clothamount = txtClothAmount
        rs.Fields!unit = ComUnit
        rs.Fields!Stockdate = Stockdate
        rs.Fields!Shipmentsdate = Shipmentsdate.Value
        rs.Fields!Packing = txtPacking
        rs.Fields!StockAmount = txtStockAmount
        rs.Fields!CustomerName = txtCustomerName
        rs.Update
        MsgBox "操作成功！", vbInformation, "恭喜"
        rs.Close
         Set rs = Nothing
        spModiNotices txtOrderNo, CInt(txtQuantity), txtNoticesNo, newItem
        frmShipmentsInfo.FillMshf1 ("select * from tShipmentsNoticesSub where NoticesNo='" & txtNoticesNo & "'")
        Unload Me
        Exit Sub
errHandle:
    Set rs = Nothing
    objDatabase.DatabaseError
End Sub

Private Sub txtClothAmount_KeyPress(KeyAscii As Integer)
If KeyAscii <> 8 And KeyAscii <> 13 And KeyAscii <> 46 Then
            If KeyAscii < 48 Or KeyAscii > 57 Then KeyAscii = 0
 End If
End Sub

Private Sub txtQuantity_KeyPress(KeyAscii As Integer)
If KeyAscii <> 8 And KeyAscii <> 13 And KeyAscii <> 46 Then
            If KeyAscii < 48 Or KeyAscii > 57 Then KeyAscii = 0
 End If
End Sub