frmstorehouseproduct.frm

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

         Left            =   5040
         TabIndex        =   68
         Top             =   7320
         Width           =   855
      End
      Begin VB.Label Label2 
         Caption         =   "创建人"
         Height          =   255
         Index           =   0
         Left            =   360
         TabIndex        =   67
         Top             =   7320
         Width           =   735
      End
   End
   Begin VB.Label Label5 
      Caption         =   "布號"
      Height          =   195
      Left            =   180
      TabIndex        =   4
      Top             =   60
      Width           =   1035
   End
End
Attribute VB_Name = "frmBasicProduct"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Public newItem As Boolean 'true表示增加

Private Sub cmdCancel_Click()
    Unload Me
End Sub

Private Sub cmdOk_Click()
    If SSTab1.Tab = 0 Then
        Save newItem, 1
    Else
        Save newItem, 0
    End If
End Sub



Private Sub Form_Load()
    '设置窗口大小
   ' FormInit Me, False
    Me.Move (Screen.Width - Me.Width) \ 2, (Screen.Height - Me.Height) \ 2
    InitTitle
    Initcbb Weave, "eWeave", "tBasicWeave"
    Initcbb txtWeave, "eWeave", "tBasicWeave"
    Initcbb Composition, "eComposition", "tBasicComposition"
    Initcbb txtComposition, "eComposition", "tBasicComposition"
    Initcbb CompositionType, "eCompositionType", "tBasicCompositionType"
    Initcbb txtCompositionType, "eCompositionType", "tBasicCompositionType"
    Initcbb Stretch, "eStretch", "tBasicStretch"
    Initcbb txtStretch, "eStretch", "tBasicStretch"
    Initcbb proyarnType, "eYarnType", "tBasicYarnType"
    Initcbb txtYarnType, "eYarnType", "tBasicYarnType"
    Initcbb FabricType, "eFabricType", "tBasicFabricType"
    Initcbb txtFabricType, "eFabricType", "tBasicFabricType"
    Initcbb Color, "eColor", "tBasicColor"
    Initcbb txtColor, "eColor", "tBasicColor"
    Initcbb unit, "UnitName", "tBasicUnit"
    Initcbb txtUnit, "UnitName", "tBasicUnit"
    If newItem = True Then
        Dim rs As ADODB.Recordset
        Set rs = New ADODB.Recordset
        If viewFlag Then
            rs.Open "select id from tBasicFabric", Cn, 1, 3
            If rs.EOF Or rs.BOF Then
               txtCode = "0001"
               Exit Sub
            End If
            rs.MoveLast
            txtCode = String(4 - Len(rs.Fields!ID + 1), "0") & rs.Fields!ID + 1
            rs.Close
        Else
            rs.Open "select id from tBasicProduct", Cn, 1, 3
            If rs.EOF Or rs.BOF Then
               txtCode = "0001"
               Exit Sub
            End If
            rs.MoveLast
            txtCode = String(5 - Len(rs.Fields!ID + 1), "0") & rs.Fields!ID + 1
            rs.Close
        End If
        Set rs = Nothing
    End If
    If viewFlag Then
        SSTab1.Tab = 0
    Else
        SSTab1.Tab = 1
    End If
End Sub
Private Sub InitTitle()
    Label5.Caption = "布號"
    Label1.Caption = "布名"
    Label2.item(1).Caption = "英文名稱"
    Label3.item(1).Caption = "組織"
    Label24.Caption = "成份"
    Label3.item(2).Caption = "成份類型"
    Label11.Caption = "拉伸"
    Label16.Caption = "紗織"
    Label6.Caption = "紗類型"
    Label14.Caption = "紗數"
    Label17.Caption = "經動"
    Label18.Caption = "緯動"
    Label19.Caption = "緯"
    Label4.Caption = "經"
    Label20.Caption = "類型"
    Label21.Caption = "坑數"
    Label28.Caption = "片數"
    Label29.Caption = "成品組織"
    Label30.Caption = "胚組織"
    Label31.Caption = "淨重"
    Label32.Caption = "幅寬"
    Label33.Caption = "密度"
    Label34.Caption = "整理"
    Label35.Caption = "價格"
    Label36.Caption = "備註"
    Label53.Caption = "色位"
    Label52.Caption = "單位"
    Label37.Caption = "擴展一"
    Label38.Caption = "擴展二"
    Label2.item(0).Caption = "創建人"
    Label3.item(0).Caption = "創建日期"
    Label50.Caption = "原布號"
    Label22.Caption = "布名"
    Label2.item(2).Caption = "英文名稱"
    Label3.item(3).Caption = "組織"
    Label27.Caption = "成份"
    Label3.item(4).Caption = "成份類型"
    Label26.Caption = "拉伸"
    Label15.Caption = "紗織"
    YarnType.Caption = "紗類型"
    Label13.Caption = "紗數"
    Label12.Caption = "經動"
    Label10.Caption = "緯動"
    Label9.Caption = "緯"
    Label23.Caption = "經"
    Label8.Caption = "類型"
    Label7.Caption = "坑數"
    Label39.Caption = "片數"
    Label40.Caption = "成品組織"
    Label41.Caption = "胚組織"
    Label42.Caption = "淨重"
    Label43.Caption = "幅寬"
    Label44.Caption = "密度"
    Label45.Caption = "整理"
    Label46.Caption = "價格"
    Label47.Caption = "備註"
    Label54.Caption = "色位"
    Label51.Caption = "單位"
    Label48.Caption = "擴展一"
    Label49.Caption = "擴展二"
    Label2.item(3).Caption = "創建人"
    Label3.item(5).Caption = "創建日期"
    ComboAdd.AddItem ("供應商")
    ComboAdd.AddItem ("客戶")
    ComboAdd.AddItem ("庫存")
    ComboView.AddItem ("供應商")
    ComboView.AddItem ("客戶")
    ComboView.AddItem ("庫存")
    Me.Caption = "布種布樣"
End Sub
'初始化
Public Sub InitInfo(strId 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
    If viewFlag Then
      strSql = "select * from tBasicFabric where FabricCode='" & strId & "'"
      rs.Open strSql
        If Not rs.EOF Then
            txtFabricCode.Text = Left(rs.Fields!FabricCode, 3)
            txtFabricCode.Locked = True
            txtCode.Text = Mid(rs.Fields!FabricCode, 4)
            txtFabricName.Text = NullValue(rs.Fields!FabricName)
            txteFabricName.Text = NullValue(rs.Fields!eFabricName)
            txtColor.Text = NullValue(rs.Fields!Color)
            txtWeave.Text = NullValue(rs.Fields!Weave)
            txtCompositionType.Text = NullValue(rs.Fields!CompositionType)
            txtComposition.Text = NullValue(rs.Fields!Composition)
            txtStretch.Text = NullValue(rs.Fields!Stretch)
            txtYarn.Text = NullValue(rs.Fields!Yarn)
            txtYarnType.Text = NullValue(rs.Fields!YarnType)
            txtyarnCount.Text = NullValue(rs.Fields!YarnCount)
            txtwarpOfcon.Text = NullValue(rs.Fields!WarpOfCon)
            txtweftOfcon = NullValue(rs.Fields!WeftOfCon)
            txtweft.Text = NullValue(rs.Fields!Weft)
            txtwarp.Text = NullValue(rs.Fields!Warp)
            txtFabricType.Text = NullValue(rs.Fields!FabricType)
            txtWales.Text = NullValue(rs.Fields!Wales)
            txtHarness.Text = NullValue(rs.Fields!Harness)
            txtConstrustion.Text = NullValue(rs.Fields!Construstion)
            txtFabricType.Text = NullValue(rs.Fields!FabricType)
            txtGreige.Text = NullValue(rs.Fields!Greige)
            txtActualweight.Text = NullValue(rs.Fields!Actualweight)
            txtwidth.Text = NullValue(rs.Fields!Width)
            txtdensity.Text = NullValue(rs.Fields!density)
            txtFinish.Text = NullValue(rs.Fields!Finish)
            txtPrice.Text = NullValue(rs.Fields!Price)
            txtUnit.Text = NullValue(rs.Fields!unit)
            txtRemarks.Text = NullValue(rs.Fields!Remarks)
            txtRemarkEx1.Text = NullValue(rs.Fields!remarkEx1)
            txtRemarkEx2.Text = NullValue(rs.Fields!RemarkEx2)
            txtUpdateDate.Text = NullValue(rs.Fields!UpdateDate)
        End If
        rs.Close
    Else
        strSql = "select * from tBasicProduct where FabricCode='" & strId & "'"
        rs.Open strSql
        If Not rs.EOF Then
            txtFabricCode.Text = Left(rs.Fields!FabricCode, 3)
            txtFabricCode.Locked = True
            txtCode.Text = Mid(rs.Fields!FabricCode, 4)
            OldFabricCode.Text = NullValue(rs.Fields!OldFabricCode)
            OldFabricCode.Locked = True
            FabricName.Text = NullValue(rs.Fields!FabricName)
            eFabricName.Text = NullValue(rs.Fields!eFabricName)
            Color.Text = NullValue(rs.Fields!Color)
            Weave.Text = NullValue(rs.Fields!Weave)
            CompositionType.Text = NullValue(rs.Fields!CompositionType)
            Composition.Text = NullValue(rs.Fields!Composition)
            Stretch.Text = NullValue(rs.Fields!Stretch)
            Yarn.Text = NullValue(rs.Fields!Yarn)
            proyarnType.Text = NullValue(rs.Fields!YarnType)
            YarnCount.Text = NullValue(rs.Fields!YarnCount)
            WarpOfCon.Text = NullValue(rs.Fields!WarpOfCon)
            WeftOfCon = NullValue(rs.Fields!WeftOfCon)
            Weft.Text = NullValue(rs.Fields!Weft)
            Warp.Text = NullValue(rs.Fields!Warp)
            FabricType.Text = NullValue(rs.Fields!FabricType)
            Wales.Text = NullValue(rs.Fields!Wales)
            Harness.Text = NullValue(rs.Fields!Harness)
            Construstion.Text = NullValue(rs.Fields!Construstion)
            FabricType.Text = NullValue(rs.Fields!FabricType)
            Greige.Text = NullValue(rs.Fields!Greige)
            Actualweight.Text = NullValue(rs.Fields!Actualweight)
            proWidth.Text = NullValue(rs.Fields!Width)
            density.Text = NullValue(rs.Fields!density)
            Finish.Text = NullValue(rs.Fields!Finish)
            Price.Text = NullValue(rs.Fields!Price)
            unit.Text = NullValue(rs.Fields!unit)
            Remarks.Text = NullValue(rs.Fields!Remarks)
            remarkEx1.Text = NullValue(rs.Fields!remarkEx1)
            RemarkEx2.Text = NullValue(rs.Fields!RemarkEx2)
            UpdateDate.Text = NullValue(rs.Fields!UpdateDate)
        End If
        rs.Close
     End If
      Set rs = Nothing
      SystemExecuteEnd Me
End If
Exit Sub
errLabel:
    SystemExecuteEnd Me
    objDatabase.DatabaseError
End Sub
Private Sub Save(Optional blModi As Boolean, Optional flag As Boolean)
    Dim strSql, strCode As String
    Dim strCdh, strZl, strSl As String
    Dim rs As ADODB.Recordset
    strCode = Trim$(txtFabricCode) + Trim$(txtCode)
    If flag Then
    strSql = "select * from tBasicFabric where FabricCode='" & strCode & "'"
    Else
    strSql = "select * from tBasicProduct where FabricCode='" & strCode & "'"
    End If
    On Error GoTo errHandle
    Set rs = New ADODB.Recordset
    With rs
      .CursorLocation = adUseClient
      .CursorType = adOpenDynamic
      .LockType = adLockOptimistic
      Set .ActiveConnection = Cn
    End With
    rs.Open strSql
    If txtFabricCode.Text = "" Then
        MsgBox "布号不能為空！", vbCritical, "提示"
        rs.Close
        Set rs = Nothing
        txtFabricCode.SetFocus
        Exit Sub
    End If
    If blModi Then
        If Not rs.EOF Then
            MsgBox "此布號已存在！", vbCritical, "提示"
            txtFabricCode.Text = ""
            txtFabricCode.SetFocus
            rs.Close
            Set rs = Nothing
            Exit Sub
        End If
        If MsgBox("是否增加新布種？", vbQuestion + vbYesNo, "询问") = vbNo Then
            rs.Close
            Set rs = Nothing
            Exit Sub
        End If
                
        rs.AddNew '新建
    Else
        If rs.EOF Then '修改
            MsgBox "没有可修改的信息!", vbExclamation, "修改"
            rs.Close
            Set rs = Nothing
            txtFabricCode.SetFocus
            Exit Sub
        End If
        If MsgBox("是否修改记录？", vbYesNo + vbQuestion, "修改") = vbNo Then
            rs.Close
            Set rs = Nothing
            Exit Sub
        End If
    End If
        If flag = False Then rs.Fields!OldFabricCode = Trim$(OldFabricCode)
        rs.Fields!FabricCode = Trim$(strCode)
        rs.Fields!FabricName = IIf(flag, Trim$(txtFabricName), FabricName)
        rs.Fields!eFabricName = IIf(flag, Trim$(txteFabricName), eFabricName)
        rs.Fields!Color = IIf(flag, Trim$(txtColor), Color)
        rs.Fields!Weave = IIf(flag, Trim$(txtWeave.Text), Weave)
        rs.Fields!CompositionType = IIf(flag, Trim$(txtCompositionType), CompositionType)
        rs.Fields!Composition = IIf(flag, Trim$(txtComposition), Composition)
        rs.Fields!Stretch = IIf(flag, Trim$(txtStretch.Text), Stretch)
        rs.Fields!Yarn = IIf(flag, Trim$(txtYarn.Text), Yarn)
        rs.Fields!YarnType = IIf(flag, Trim$(txtYarnType), proyarnType)
        rs.Fields!YarnCount = IIf(flag, Trim$(txtyarnCount), YarnCount)
        rs.Fields!WarpOfCon = IIf(flag, Trim$(txtwarpOfcon.Text), WarpOfCon)
        rs.Fields!WeftOfCon = IIf(flag, Trim$(txtweftOfcon.Text), WeftOfCon)
        rs.Fields!Weft = IIf(flag, Trim$(txtweft), Weft)
        rs.Fields!Warp = IIf(flag, Trim$(txtwarp.Text), Warp)
        rs.Fields!FabricType = IIf(flag, FabricType, FabricType)
        rs.Fields!Wales = IIf(flag, Trim$(txtWales.Text), Wales)
        rs.Fields!Harness = IIf(flag, Trim$(txtHarness.Text), Harness)
        rs.Fields!Construstion = IIf(flag, Trim$(txtConstrustion.Text), Construstion)
        rs.Fields!Greige = IIf(flag, Trim$(txtGreige.Text), Greige)
        rs.Fields!Actualweight = IIf(flag, Trim$(txtActualweight.Text), Actualweight)
        rs.Fields!Width = IIf(flag, Trim$(txtwidth.Text), proWidth)
        rs.Fields!density = IIf(flag, Trim$(txtdensity.Text), density)
        rs.Fields!Finish = IIf(flag, Trim$(txtFinish.Text), Finish)
        rs.Fields!Price = IIf(flag, IIf(txtPrice.Text = "", "0.00", txtPrice), IIf(Price = "", "0.00", Price))
        rs.Fields!unit = IIf(flag, Trim$(txtUnit.Text), unit)
        rs.Fields!Remarks = IIf(flag, Trim$(txtRemarks.Text), Remarks)
        rs.Fields!remarkEx1 = IIf(flag, Trim$(txtRemarkEx1.Text), remarkEx1)
        rs.Fields!RemarkEx2 = IIf(flag, Trim$(txtRemarkEx2.Text), RemarkEx2)
        rs.Fields!UpdateDate = Now
        rs.Update
        MsgBox "操作成功！", vbInformation, "恭喜"
    rs.Close
    Set rs = Nothing
    If flag = False Then
       frmBasicFabric.FillMshf1 ("select * from tBasicProduct")
    Else
       frmBasicFabric.FillMshf1 ("select * from tBasicFabric")
    End If
    Unload Me
    Exit Sub
    
errHandle:
    Set rs = Nothing
    objDatabase.DatabaseError
End Sub


Private Sub Price_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 txtPrice_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 CmdAdd_Click()
Select Case ComboAdd.Text
    Case "供應商":
            With frmBasicFabricSuppliersInfo
                '.newItem = False
                .InitInfo ""
                .ProductCode = txtFabricCode + txtCode
                .Show
            End With
            Unload Me
    Case "客戶":
            With frmBasicClientOrderInfo
                .InitInfo ""
                .ProductCode = txtFabricCode + txtCode
                .Show
            End With
            Unload Me
    Case "庫存":
            With frmBasicStockInfo
               ' .newItem = False
               ' .InitInfo ""
                .ProductCode = txtFabricCode + txtCode
                .Show
            End With
            Unload Me
End Select
End Sub
Private Sub CmdView_Click()
Select Case ComboAdd.Text
    Case "供應商":
            frmBasicFabricSuppliers.FillMshf1 ("select * from tBasicFabricSuppliers where ProductCode='" & txtFabricCode + txtCode & "'")
            frmBasicFabricSuppliers.Show
            Unload Me
    Case "客戶":
            frmBasicClientOrder.FillMshf1 ("select * from tBasicClientOrder where ProductCode='" & txtFabricCode + txtCode & "'")
            frmBasicClientOrder.Show
            Unload Me
    Case "庫存":
            frmBasicStock.FillMshf1 ("select * from tBasicStock where ProductCode='" & txtFabricCode + txtCode & "'")
            frmBasicStock.Show
            Unload Me
End Select
End Sub