frmclaiminfo.frm

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

         Begin VB.Label Label2 
            Caption         =   "索賠描述"
            Height          =   255
            Index           =   12
            Left            =   360
            TabIndex        =   13
            Top             =   2040
            Width           =   1035
         End
         Begin VB.Label Label12 
            Caption         =   "總金額"
            Height          =   315
            Left            =   4380
            TabIndex        =   12
            Top             =   3960
            Width           =   795
         End
         Begin VB.Label Label13 
            Caption         =   "發票數量"
            Height          =   315
            Left            =   4380
            TabIndex        =   11
            Top             =   4440
            Width           =   735
         End
         Begin VB.Label Label14 
            Caption         =   "發票單價"
            Height          =   315
            Left            =   420
            TabIndex        =   10
            Top             =   4440
            Width           =   795
         End
         Begin VB.Label Label15 
            Caption         =   "索賠"
            Height          =   255
            Left            =   420
            TabIndex        =   9
            Top             =   4860
            Width           =   795
         End
      End
   End
End
Attribute VB_Name = "frmClaimInfo"
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
    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)
            txtFabricInfo = NullValue(rs.Fields!Composition)
        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 ComUnit, "UnitName", "tBasicUnit"
    Initcbb ComFactoryName, "FactoryName", "tBasicFactory"
    Initcbb ComCurrencyName, "CurrencyName", "tBasicCurrency"
    Initcbb ComRate, "Rate", "tBasicCurrency"
    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 = "索賠描述"
    Label4.Caption = "幣種"
    Label3.Caption = "數量"
    Label6.Caption = "單價"
    Label5.Caption = "對應匯率"
    Label7.Caption = "單位"
    Label12.Caption = "總金額"
    Label14.Caption = "發票單價"
    Label13.Caption = "發票數量"
    Label15.Caption = "索賠"
    Label8.Caption = "加工廠"
    Label9.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  tEricClaimList where id=" & txtId
        objDatabase.ExecCmd strSql
        MsgBox "刪除成功!", vbInformation, "提示"
    End If
        frmClaim.FillMshf1 ("select * from tEricClaimList")
        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 tEricClaimList where id=" & strId
        rs.Open strSql
        If Not rs.EOF Then
            Founddate = NullValue(rs.Fields!Founddate)
            txtContractNo = NullValue(rs.Fields!ContractNo)
            txtOrderNo = NullValue(rs.Fields!OrderNo)
            ComFabricNo = NullValue(rs.Fields!FabricNo)
            ComFabricName = NullValue(rs.Fields!FabricName)
            txtFabricInfo = NullValue(rs.Fields!Composition)
            ColorLayout = NullValue(rs.Fields!LayoutColor)
           ' txteLayoutColor = NullValue(rs.Fields!elayoutcolor)
            Delivery = NullValue(rs.Fields!Delivery)
            txtClaimReason = NullValue(rs.Fields!ClaimReason)
            txtQuantity = NullValue(rs.Fields!Quantity)
            ComCurrencyName = NullValue(rs.Fields!CurrencyName)
            ComRate = NullValue(rs.Fields!Rate)
            txtPrice = NullValue(rs.Fields!Price)
            ComUnit = NullValue(rs.Fields!unit)
            txtAmount = NullValue(rs.Fields!Amount)
            txtInvoiceQuantity = NullValue(rs.Fields!InvoiceQuantity)
            txtInvoicePrice = NullValue(rs.Fields!InvoicePrice)
            txtClaimAmount = NullValue(rs.Fields!ClaimAmount)
            ComFactoryName = NullValue(rs.Fields!FactoryName)
            txtId = NullValue(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 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 txtContractNo = "" Then
            MsgBox "請填寫合同編號", vbCritical, "提示"
            txtContractNo.SetFocus
            Exit Sub
        End If
        If IsNumeric(txtQuantity) = False Then
            MsgBox "請在數量上填寫正確格式", vbCritical, "提示"
            txtQuantity.SetFocus
            Exit Sub
        End If
        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(txtInvoicePrice) = False Then
            MsgBox "請在發票單價上填寫正確格式", vbCritical, "提示"
            txtInvoicePrice.SetFocus
            Exit Sub
        End If
        If IsNumeric(txtInvoiceQuantity) = False Then
            MsgBox "請在發票數量上填寫正確格式", vbCritical, "提示"
            txtInvoiceQuantity.SetFocus
            Exit Sub
        End If
        If IsNumeric(txtClaimAmount) = False Then
            MsgBox "請在索賠上填寫正確格式", vbCritical, "提示"
            txtClaimAmount.SetFocus
            Exit Sub
        End If
        If blModi Then
        strSql = "select * from tEricClaimList"
        rs.Open strSql
            If MsgBox("是否增加？", vbQuestion + vbYesNo, "询问") = vbNo Then
                rs.Close
                Set rs = Nothing
                Exit Sub
            End If
                    
            rs.AddNew '新建
        Else
            strSql = "select * from tEricClaimList where id=" & txtId
            rs.Open strSql
            If rs.EOF Then '修改
                MsgBox "没有可修改的信息!", vbExclamation, "修改"
                rs.Close
                Set rs = Nothing
                txtContractNo.SetFocus
                Exit Sub
            End If
            If MsgBox("是否修改记录？", vbYesNo + vbQuestion, "修改") = vbNo Then
                rs.Close
                Set rs = Nothing
                Exit Sub
            End If
        End If
        rs.Fields!Founddate = Founddate
        rs.Fields!ContractNo = txtContractNo
        rs.Fields!OrderNo = txtOrderNo
        rs.Fields!FabricNo = ComFabricNo
        rs.Fields!FabricName = ComFabricName
        rs.Fields!Composition = txtFabricInfo
        rs.Fields!LayoutColor = ColorLayout.Text
        'rs.Fields!elayoutcolor = txteLayoutColor
        rs.Fields!Delivery = Delivery
        rs.Fields!ClaimReason = txtClaimReason
        rs.Fields!Quantity = txtQuantity
        rs.Fields!CurrencyName = ComCurrencyName
        rs.Fields!Rate = ComRate
        rs.Fields!Price = txtPrice
        rs.Fields!unit = ComUnit
        rs.Fields!Amount = txtAmount
        rs.Fields!InvoiceQuantity = txtInvoiceQuantity
        rs.Fields!InvoicePrice = txtInvoicePrice
        rs.Fields!ClaimAmount = txtClaimAmount
        rs.Fields!FactoryName = ComFactoryName
        rs.Update
        MsgBox "操作成功！", vbInformation, "恭喜"
        rs.Close
         Set rs = Nothing
        frmClaim.FillMshf1 ("select * from tEricClaimList")
        Unload Me
        Exit Sub
errHandle:
    Set rs = Nothing
    objDatabase.DatabaseError
End Sub
Private Sub txtAmount_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 txtClaimAmount_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 txtInvoicePrice_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 txtInvoiceQuantity_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 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