📄 frmproductionembryocontractinfo.frm

📁 企业ERP系统采用VB+SQL2000实现。有客户合约
💻 FRM
📖 第 1 页 / 共 2 页
字号:
上一页 12
            TabIndex        =   16
            Top             =   2220
            Width           =   1035
         End
         Begin VB.Label Label2 
            Caption         =   "布號"
            Height          =   255
            Index           =   9
            Left            =   360
            TabIndex        =   15
            Top             =   1620
            Width           =   1035
         End
         Begin VB.Label Label2 
            Caption         =   "布名"
            Height          =   255
            Index           =   8
            Left            =   4380
            TabIndex        =   14
            Top             =   1620
            Width           =   1035
         End
         Begin VB.Label Label2 
            Caption         =   "業務員"
            Height          =   255
            Index           =   5
            Left            =   4380
            TabIndex        =   13
            Top             =   1200
            Width           =   735
         End
         Begin VB.Label Label2 
            Caption         =   "業務聯絡人"
            Height          =   255
            Index           =   6
            Left            =   360
            TabIndex        =   12
            Top             =   1200
            Width           =   1035
         End
         Begin VB.Label Label1 
            Caption         =   "合同編號"
            Height          =   255
            Left            =   360
            TabIndex        =   11
            Top             =   360
            Width           =   1035
         End
         Begin VB.Label Label2 
            Caption         =   "訂坯日期"
            Height          =   255
            Index           =   1
            Left            =   360
            TabIndex        =   10
            Top             =   780
            Width           =   1035
         End
         Begin VB.Label Label2 
            Caption         =   "供應商"
            Height          =   255
            Index           =   0
            Left            =   4380
            TabIndex        =   9
            Top             =   360
            Width           =   735
         End
         Begin VB.Label Label2 
            Caption         =   "坯布交期"
            Height          =   255
            Index           =   2
            Left            =   4380
            TabIndex        =   8
            Top             =   780
            Width           =   1035
         End
      End
   End
End
Attribute VB_Name = "frmProductionEmbryoContractInfo"
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 ActiveBar21_ToolClick(ByVal Tool As ActiveBar2LibraryCtl.Tool)
    Select Case Tool.Name
            Case "cmdSave":
                 Save newItem
           Case "cmdCancel":
                Unload Me
            Case "cmdDel":
                DelOperatorInf
            Case "cmdPrint"
                Call PrintEmbryoContract
    End Select
End Sub
Private Sub PrintEmbryoContract()
   Dim rs As ADODB.Recordset
   Set rs = New ADODB.Recordset
   Dim strSql As String
    With rs
      .CursorLocation = adUseClient
      .CursorType = adOpenDynamic
      .LockType = adLockOptimistic
      Set .ActiveConnection = Cn
    End With
    strSql = "select * from tProductionEmbryoContract as a,tBasicFabric as b "
    strSql = strSql & "where EmbryoContractNo='" & txtEmbryoContractNo & "'and a.FabricCode='" & ComFabricCode & "' and b.FabricCode='" & ComFabricCode & "'"
    rs.Open strSql
   With BillEmbryoContract
'       .EmbryoContractNo.SetText (rs.Fields!EmbryoContractNo)
'       .FoundDate.SetText (rs.Fields!FoundDate)
'       .SuppliersName.SetText (rs.Fields!SuppliersName)
'       .Linkman.SetText (rs.Fields!Linkman)
'       .Operation.SetText (rs.Fields!Operation)
'       .FabricName.SetText (rs.Fields!FabricName)
'       .Composition.SetText (rs.Fields!Composition)
'       .fWidth.SetText (txtwidth)
'       .FabricCode.SetText (rs.Fields!FabricCode)
'       .Price.SetText (rs.Fields!Price)
'       .Delivery.SetText (rs.Fields!Delivery)
'      ' .Remark.SetText (rs.Fields!Remark)
'       .Amount.SetText (rs.Fields!Amount)
   End With
    rs.Close
    Set rs = Nothing
    frmReportEmbryoContract.Show vbModal
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
            ComFabricCode = NullValue(rs.Fields!FabricCode)
            ComFabricName = NullValue(rs.Fields!FabricName)
            txtGreige = NullValue(rs.Fields!Greige)
            txtwidth = NullValue(rs.Fields!Width)
            txtPrice = NullValue(rs.Fields!Price)
        End If
    rs.Close

remClear:
    Set rs = Nothing
    Exit Sub
errLabel:
    objDatabase.DatabaseError
    GoTo remClear
End Sub
Private Sub Form_Load()
    Me.Move (Screen.Width - Me.Width) \ 2, (Screen.Height - Me.Height) \ 2
    Initcbb ComFactoryName, "FactoryName", "tBasicFactory"
    Initcbb comUnitName, "UnitName", "tBasicUnit"
    Initcbb comSuppliersName, "Supplier", "tBasicFabricSuppliers"
    Initcbb txtCurrencyName, "CurrencyName", "tBasicCurrency"
    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 = "備註"
    Label2.item(3).Caption = "付款情況"
    Label2.item(13).Caption = "胚組織"
    Label2.item(11).Caption = "投坯數量"
    Label2.item(7).Caption = "幅寬"
    Label2.item(10).Caption = "實收數"
    Label2.item(4).Caption = "訂胚數量"
    Label2.item(14).Caption = "存坯數量"
    Label2.item(17).Caption = "加工廠簡稱"
    Label2.item(15).Caption = "加工廠倉號"
    Label3.Caption = "胚價"
    Label4.Caption = "幣種簡稱"
    Label5.Caption = "單位名稱"
    Label6.Caption = "進胚交期"
    Label2.item(18).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  tProductionEmbryoContract where id=" & txtId
        objDatabase.ExecCmd strSql
        MsgBox "刪除成功!", vbInformation, "提示"
    End If
        frmProductionEmbryoContractMain.FillMshf1 ("select * from tProductionEmbryoContract")
    Unload Me
    Exit Sub
errHandle:
   objDatabase.DatabaseError
    
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
        strSql = "select * from tProductionEmbryoContract where id=" & strId
        rs.Open strSql
        If Not rs.EOF Then
            txtEmbryoContractNo.Text = NullValue(rs.Fields!EmbryoContractNo)
            DtpFoundDate.Value = NullValue(rs.Fields!Founddate)
            DTPdelivery.Value = NullValue(rs.Fields!Delivery)
            comSuppliersName = NullValue(rs.Fields!SuppliersName)
            txtLinkman = NullValue(rs.Fields!Linkman)
            txtOperation = NullValue(rs.Fields!Operation)
            ComFabricCode = IIf(IsNull(rs.Fields!FabricCode), "", rs.Fields!FabricCode)
            ComFabricName = IIf(IsNull(rs.Fields!FabricName), "", rs.Fields!FabricName)
            txtGreige = NullValue(rs.Fields!Greige)
            txtwidth = NullValue(rs.Fields!Width)
            txtRemark = NullValue(rs.Fields!Remark)
            txtPayments = NullValue(rs.Fields!Payments)
            txtPrice = NullValue(rs.Fields!Price)
            txtCurrencyName = NullValue(rs.Fields!CurrencyName)
            txtAmount = NullValue(rs.Fields!Amount)
            comUnitName = NullValue(rs.Fields!UnitName)
            DtpCurrentDate.Value = rs.Fields!CurrentDate
            txtCurrentAmount = IIf(IsNull(rs.Fields!CurrentAmount), "0", rs.Fields!CurrentAmount)
            txtConsumeAmount = IIf(IsNull(rs.Fields!ConsumeAmount), "0", rs.Fields!ConsumeAmount)
            txtLeftAmount = IIf(IsNull(rs.Fields!leftAmount), "0", rs.Fields!leftAmount)
            ComFactoryName = NullValue(rs.Fields!FactoryName)
            txtFactoryWharf = NullValue(rs.Fields!FactoryWharf)
            txtEmbryoPlan = IIf(IsNull(rs.Fields!EmbryoPlan), "", rs.Fields!EmbryoPlan)
            txtId = NullValue(rs.Fields!ID)
        End If
        rs.Close
      Set rs = Nothing
      SystemExecuteEnd Me
Exit Sub
SystemExecuteEnd Me
Exit Sub
End If
errLabel:
    SystemExecuteEnd Me
    objDatabase.DatabaseError
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 IsNumeric(txtPrice) = False Then
            MsgBox "請在胚價上填寫正確格式", vbCritical, "提示"
            txtPrice.SetFocus
            Exit Sub
        End If
        If IsNumeric(txtAmount) = False Then
            MsgBox "請在訂胚數量上填寫正確格式", vbCritical, "提示"
            txtAmount.SetFocus
            Exit Sub
        End If
        If IsNumeric(txtConsumeAmount) = False Then
            MsgBox "請在投胚胚數量上填寫正確格式", vbCritical, "提示"
            txtConsumeAmount.SetFocus
            Exit Sub
        End If
        If txtEmbryoContractNo = "" Then
           MsgBox "請將信息填寫完整 ", vbCritical, " 提示"
           txtEmbryoContractNo.SetFocus
           Exit Sub
        End If
        If blModi Then
        strSql = "select * from tProductionEmbryoContract"
        rs.Open strSql
            If MsgBox("是否增加？", vbQuestion + vbYesNo, "询问") = vbNo Then
                rs.Close
                Set rs = Nothing
                Exit Sub
            End If
                    
            rs.AddNew '新建
        Else
            strSql = "select * from tProductionEmbryoContract where id=" & txtId
            rs.Open strSql
            If rs.EOF Then '修改
                MsgBox "没有可修改的信息!", vbExclamation, "修改"
                rs.Close
                Set rs = Nothing
                txtEmbryoContractNo.SetFocus
                Exit Sub
            End If
            If MsgBox("是否修改记录？", vbYesNo + vbQuestion, "修改") = vbNo Then
                rs.Close
                Set rs = Nothing
                Exit Sub
            End If
        End If
        rs.Fields!EmbryoContractNo = Trim$(txtEmbryoContractNo)
        rs.Fields!Founddate = DtpFoundDate.Value
        rs.Fields!Delivery = DTPdelivery.Value
        rs.Fields!SuppliersName = comSuppliersName
        rs.Fields!Linkman = Trim$(txtLinkman)
        rs.Fields!Operation = Trim$(txtOperation)
        rs.Fields!FabricCode = ComFabricCode
        rs.Fields!FabricName = ComFabricName
        rs.Fields!Greige = txtGreige
        rs.Fields!Width = txtwidth
        rs.Fields!Remark = txtRemark
        rs.Fields!Payments = txtPayments
        rs.Fields!Price = txtPrice
        rs.Fields!CurrencyName = txtCurrencyName
        rs.Fields!Amount = txtAmount
        rs.Fields!UnitName = comUnitName
        rs.Fields!CurrentDate = DtpCurrentDate.Value
        rs.Fields!CurrentAmount = txtCurrentAmount
        rs.Fields!ConsumeAmount = txtConsumeAmount
        rs.Fields!leftAmount = txtLeftAmount
        rs.Fields!FactoryName = ComFactoryName
        rs.Fields!FactoryWharf = txtFactoryWharf
        rs.Fields!EmbryoPlan = txtEmbryoPlan
        rs.Update
        MsgBox "操作成功！", vbInformation, "恭喜"
        rs.Close
         Set rs = Nothing
        frmProductionEmbryoContractMain.FillMshf1 ("select * from tProductionEmbryoContract")
        Unload Me
        Exit Sub
errHandle:
    Set rs = Nothing
    objDatabase.DatabaseError
End Sub

Private Sub txtConsumeAmount_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 txtCurrentAmount_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 txtLeftAmount_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
上一页 12
⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -