frmcut.frm

用VB6.0编写的关于车辆运输调度的系统

            End With
            vascut.Enabled = False
            txtentc.Enabled = False
            cmbcusc.Enabled = False
            txtprod.Enabled = False
            txtcusd.Enabled = False
            frminput.Enabled = True
            txttnkc.Enabled = False
            cmbproc.SetFocus
        Case "cancel"
            With UserControl1
                .DisplayButton "New", "New", True, , "New"
                .DisplayButton "Find", "Find", True, , "Find"
                .DisplayButton "Modify", "Modify", True, , "Modify"
                .DisplayButton "Save", "Save", False, , "Save"
                .DisplayButton "Cancel", "Cancel", False, , "Cancel"
                .DisplayButton "Close", "Close", True, , "Close"
            End With
           
            txtentc.Enabled = True
            cmbcusc.Enabled = True
            txttnkc.Enabled = True
            txttnkd.Enabled = True
            txtlocc.Enabled = True
            cmbproc.Enabled = True
            txtmeau.Enabled = True
            txtconv.Enabled = True
            txtconf.Enabled = True
            txtphys.Enabled = True
            txtmaxl.Enabled = True
            txtminl.Enabled = True
            txtsafl.Enabled = True
            vascut.Enabled = True
            frminput.Enabled = False
            txtentc.Text = gsEntCode
            lblstatus.Caption = ""
            Call vascut_Click(lCurSpdCol, lCurSpdRow)
            
        Case "find"
            With UserControl1
                .DisplayButton "New", "New", False, , "New"
                .DisplayButton "Find", "Find", False, , "Find"
                .DisplayButton "Save", "Save", False, , "Save"
                .DisplayButton "Modify", "Modify", True, , "Modify"
                .DisplayButton "Cancel", "Cancel", True, , "Cancel"
                .DisplayButton "Close", "Close", True, , "Close"
            End With
            lblstatus.Caption = "search"
            vascut.Enabled = False
            frminput.Enabled = True
            Call IniStaDetail
            txtentc.Text = gsEntCode
            txtentc.Enabled = False
            cmbcusc.Enabled = True
            txttnkc.Enabled = True
            txttnkd.Enabled = False
            txtcusd.Enabled = False
            txtlocc.Enabled = False
            cmbproc.Enabled = False
            txtprod.Enabled = False
            txtmeau.Enabled = False
            txtconv.Enabled = False
            txtconf.Enabled = False
            txtphys.Enabled = False
            txtmaxl.Enabled = False
            txtminl.Enabled = False
            txtsafl.Enabled = False
            cmbcusc.SetFocus
            
        Case "save"
            With UserControl1
                .DisplayButton "New", "New", True, , "New"
                .DisplayButton "Find", "Find", True, , "Find"
                .DisplayButton "Save", "Save", False, , "Save"
                .DisplayButton "Modify", "Modify", True, , "Modify"
                .DisplayButton "Cancel", "Cancel", False, , "Cancel"
                .DisplayButton "Close", "Close", True, , "Close"
            End With
            vascut.Enabled = True
            frminput.Enabled = False
       
        End Select

End Sub


Private Sub UserControl1_ButtonClick(ByVal Button As MSComctlLib.Button)
    On Error Resume Next
    mkey = LCase(Button.Key)
    
    Select Case LCase(Button.Key)
        Case "new"
            lblstatus.Caption = mkey
            Call IniStaDetail
             
        Case "save"
            If lblstatus.Caption = "new" Then
               If SavecutInfo = False Then
                Exit Sub
                End If
                Call vasshow
                Call display
            ElseIf lblstatus.Caption = "modify" Then
                If cutmodify = False Then
                Exit Sub
                End If
                Call vasshow
                Call display
            End If
        Case "cancel"
            Call vascut_Click(1, 1)
            
        Case "find"
            lblstatus.Caption = mkey
                        
        Case "modify"
            lblstatus.Caption = mkey
        Case "close"
            
            Unload Me
            Exit Sub
       Case Else
    
    End Select
    
    Call SetToolBar(mkey)
    
End Sub


Private Sub IniStaDetail()

txtentc.Text = gsEntCode
cmbstatus.ListIndex = 0
cmbcusc.Text = ""
txtcusd.Text = ""
txttnkc.Text = ""
txtlocc.Text = ""
cmbproc.Text = ""
txtprod.Text = ""
txtmeau.Text = ""
txtconv.Text = ""
txtconf.Text = ""
txtphys.Text = ""
txtmaxl.Text = ""
txtminl.Text = ""
txtsafl.Text = ""
txttnkd.Text = ""
cmbstatus.ListIndex = 0

End Sub

Private Function SavecutInfo() As Boolean
Dim rstcut As Recordset
Dim sSQL As String
Dim Entcode, loccode As String
Dim tnkcode, cuscode As Long
Dim procode As Long
Dim Meaunit, conveum, tnkdesc As String
Dim convfac, physize As Long
Dim maxleve, minleve, safleve As Long
Dim flag As Boolean
Dim lCurRow As Integer
Dim status As String
SavecutInfo = False
On Error GoTo err:
    If cmbcusc.Text = "" Then
        cmbcusc.Text = "0"
        ElseIf IsNumeric(getstr(cmbcusc.Text, "/")) = False Then
        MsgBox "The customer code is wront input!", vbOKOnly, "Information"
        Exit Function
    End If
    
    If txttnkc.Text = "" Then
        txttnkc.Text = "0"
        ElseIf IsNumeric(txttnkc.Text) = False Then
        MsgBox "The tank code is wrong input!", vbOKOnly, "Information"
        Exit Function
    End If
    
    If txtmeau.Text = "" Then
        MsgBox "The measurment is not input!", vbOKOnly, "Information"
        Exit Function
    End If
    If txtconv.Text = "" Then
        MsgBox "The conversion UM is not input!", vbOKOnly, "Information"
        
        Exit Function
    End If
    
    If cmbproc.Text = "" Then
        txtconf.Text = "0"
        ElseIf IsNumeric(getstr(cmbproc.Text, "/")) = False Then
        MsgBox "The product code is wrong input!", vbOKOnly, "Information"
        Exit Function
    End If
    
    If txtconf.Text = "" Then
        txtconf.Text = "0"
        ElseIf IsNumeric(txtconf.Text) = False Then
        MsgBox "The conversion Factor is wrong input!", vbOKOnly, "Information"
        Exit Function
    End If
    
    If txtphys.Text = "" Then
        txtphys.Text = "0"
        ElseIf IsNumeric(txtphys.Text) = False Then
        MsgBox "The physical size is wrong input!", vbOKOnly, "Information"
        Exit Function
    End If
    
    If txtmaxl.Text = "" Then
        txtmaxl.Text = "0"
        ElseIf IsNumeric(txtmaxl.Text) = False Then
        MsgBox "The max level is wrong input!", vbOKOnly, "Information"
        Exit Function
    End If
    
    If txtminl.Text = "" Then
        txtminl.Text = "0"
        ElseIf IsNumeric(txtminl.Text) = False Then
        MsgBox "The min level is wrong input!", vbOKOnly, "Information"
        Exit Function
    End If
    
    If txtsafl.Text = "" Then
        txtsafl.Text = "0"
        ElseIf IsNumeric(txtsafl.Text) = False Then
        MsgBox "The safety level is wrong input!", vbOKCancel, "Information"
        Exit Function
    End If

        Entcode = gsEntCode
        cuscode = CLng(getstr(cmbcusc.Text, "/"))
        tnkcode = CLng(txttnkc.Text)
        loccode = txtlocc.Text
        procode = CLng(getstr(cmbproc.Text, "/"))
        tnkdesc = txttnkd.Text
        Meaunit = txtmeau.Text
        conveum = txtconv.Text
        convfac = CLng(txtconf.Text)
        physize = CLng(txtphys.Text)
        maxleve = CLng(txtmaxl.Text)
        minleve = CLng(txtminl.Text)
        safleve = CLng(txtsafl.Text)
        status = getstr(cmbstatus.Text, "/")

    flag = cmbcusc.Text <> "" And txttnkc.Text <> "" And cmbproc.Text <> ""
    
    If flag Then
        If maxleve > safleve And safleve > minleve Then
        
        sSQL = "select * from appcut where entcode='" & Entcode & "'and cuscode =" & cuscode & "and tnkcode = " & tnkcode
        Set rstcut = Acs_cnt.Execute(sSQL)
        With rstcut
        If Not .EOF Then
            MsgBox "This Code is exist,please change the Code!", vbInformation, "Error"
            SavecutInfo = False
            Exit Function
        End If
        End With
        rstcut.Close
        Set rstcut = Nothing
               
        sSQL = "insert into appcut(entcode, cuscode,tnkcode,loccode,procode,tnkdesc,meaunit,conveum,convfac,physize,maxleve,minleve,safleve,astatus)" & _
        "values('" & Entcode & "'," & cuscode & "," & tnkcode & ",'" & loccode & "'," & procode & ",'" & tnkdesc & _
            "','" & Meaunit & "','" & conveum & "'," & convfac & "," & physize & "," & maxleve & "," & minleve & "," & safleve & ",'" & status & "')"
        Acs_cnt.BeginTrans
        Acs_cnt.Execute (sSQL)
        Acs_cnt.CommitTrans
        vascut.MaxRows = vascut.MaxRows + 1
        Else
        MsgBox " One of the Max level, min level and saf level is wrong inputed!"
        txtphys.SetFocus
        SavecutInfo = False
        Exit Function
        End If
    Else
    MsgBox "One or Some Code is Wrong input!", vbExclamation, "Error"
    SavecutInfo = False
    Exit Function
    End If

    SavecutInfo = True
    Exit Function
err:
    MsgBox err.Description, vbOKOnly, "Error"

End Function

Private Function cutmodify() As Boolean
'Dim rstcut As Recordset
Dim sSQL As String
Dim Entcode, loccode As String
Dim tnkcode, cuscode As Long
Dim procode As Long
Dim Meaunit, conveum, tnkdesc As String
Dim convfac, physize As Long
Dim maxleve, minleve, safleve As Long
Dim flag As Boolean
Dim lCurRow As Integer
Dim status As String
cutmodify = False
    
    If cmbcusc.Text = "" Then
        cmbcusc.Text = "0"
        ElseIf IsNumeric(getstr(cmbcusc.Text, "/")) = False Then
        MsgBox "The customer code is wront input!", vbOKOnly, "Information"
        Exit Function
    End If
    
    If txttnkc.Text = "" Then
        txttnkc.Text = "0"
        ElseIf IsNumeric(txttnkc.Text) = False Then
        MsgBox "The tank code is wrong input!", vbOKOnly, "Information"
        Exit Function
    End If
    
    If txtmeau.Text = "" Then
        MsgBox "The measurment is not input!", vbOKOnly, "Information"
        Exit Function
    End If
    If txtconv.Text = "" Then
        MsgBox "The conversion UM is not input!", vbOKOnly, "Information"
        
        Exit Function
    End If
    
    If cmbproc.Text = "" Then
        txtconf.Text = "0"
        ElseIf IsNumeric(getstr(cmbproc.Text, "/")) = False Then
        MsgBox "The product code is wrong input!", vbOKOnly, "Information"
        Exit Function
    End If
    
    If txtconf.Text = "" Then
        txtconf.Text = "0"
        ElseIf IsNumeric(txtconf.Text) = False Then
        MsgBox "The conversion Factor is wrong input!", vbOKOnly, "Information"
        Exit Function
    End If
    
    If txtphys.Text = "" Then
        txtphys.Text = "0"
        ElseIf IsNumeric(txtphys.Text) = False Then
        MsgBox "The physical size is wrong input!", vbOKOnly, "Information"
        Exit Function
    End If
    
    If txtmaxl.Text = "" Then
        txtmaxl.Text = "0"
        ElseIf IsNumeric(txtmaxl.Text) = False Then
        MsgBox "The max level is wrong input!", vbOKOnly, "Information"
        Exit Function
    End If
    
    If txtminl.Text = "" Then
        txtminl.Text = "0"
        ElseIf IsNumeric(txtminl.Text) = False Then
        MsgBox "The min level is wrong input!", vbOKOnly, "Information"
        Exit Function
    End If
    
    If txtsafl.Text = "" Then
        txtsafl.Text = "0"
        ElseIf IsNumeric(txtsafl.Text) = False Then
        MsgBox "The safety level is wrong input!", vbOKCancel, "Information"
        Exit Function
    End If

        Entcode = gsEntCode
        cuscode = CLng(getstr(cmbcusc.Text, "/"))
        tnkcode = CLng(txttnkc.Text)
        loccode = txtlocc.Text
        procode = CLng(getstr(cmbproc.Text, "/"))
        tnkdesc = txttnkd.Text
        Meaunit = txtmeau.Text
        conveum = txtconv.Text
        convfac = CLng(txtconf.Text)
        physize = CLng(txtphys.Text)
        maxleve = CLng(txtmaxl.Text)
        minleve = CLng(txtminl.Text)
        safleve = CLng(txtsafl.Text)
        status = getstr(cmbstatus.Text, "/")
        
     flag = cmbcusc.Text <> "" And txttnkc.Text <> "" And cmbproc.Text <> ""
    
    If flag Then
        If maxleve > safleve And safleve > minleve Then
            sSQL = "update appcut set loccode = '" & loccode & "',procode =" & procode & ", tnkdesc = '" & tnkdesc & "',meaunit = '" & Meaunit & "', conveum = '" & conveum & "',convfac = " & convfac & ", physize= " & physize & "," & _
                    "maxleve = " & maxleve & ",minleve= " & minleve & ", safleve= " & safleve & ", astatus = '" & status & "' where entcode = '" & Entcode & "' and cuscode = " & cuscode & "and tnkcode = " & tnkcode
            Acs_cnt.BeginTrans
            Acs_cnt.Execute (sSQL)
            Acs_cnt.CommitTrans
        
            lCurRow = vascut.ActiveRow
            
            SetValue vascut, lCurRow, 1, Entcode
            SetValue vascut, lCurRow, 2, cuscode
            SetValue vascut, lCurRow, 3, tnkcode
            SetValue vascut, lCurRow, 4, tnkdesc
            SetValue vascut, lCurRow, 5, loccode
            SetValue vascut, lCurRow, 6, procode
            SetValue vascut, lCurRow, 7, Meaunit
            SetValue vascut, lCurRow, 8, conveum
            SetValue vascut, lCurRow, 9, convfac
            SetValue vascut, lCurRow, 10, physize
            SetValue vascut, lCurRow, 11, maxleve
            SetValue vascut, lCurRow, 12, minleve
            SetValue vascut, lCurRow, 13, safleve
            SetValue vascut, lCurRow, 14, getstr(status, "/")
        
        Else
            MsgBox " One of the Max level, min level and saf level is wrong inputed!"
            cutmodify = False
            Exit Function
        End If
    Else
        MsgBox "One or Some items are wrong input!", vbExclamation, "Error"
    End If
    cutmodify = True
    
End Function

Private Sub display()

SetColHead vascut, cutdetail.tnkdesc, "Tank Desc", 15
SetColHead vascut, cutdetail.Meaunit, "Unit of Measurement", 20
SetColHead vascut, cutdetail.conveum, "Conversion UM", 15
SetColHead vascut, cutdetail.convfac, "Conversion Factor", 15
SetColHead vascut, cutdetail.physize, "Physical Size", 15
SetColHead vascut, cutdetail.maxleve, "Max Level", 10
SetColHead vascut, cutdetail.minleve, "Min Level", 10
SetColHead vascut, cutdetail.safleve, "Safty Level", 10
SetColHead vascut, cutdetail.Astatus, "Status", 8

End Sub

Private Function getstr(ByVal str1 As String, ByVal str2 As String) As String
Dim i As Integer
    i = InStr(1, str1, str2, vbTextCompare)
    If i >= 2 Then
        getstr = Left(str1, i - 1)
    Else
        getstr = str1
    End If
End Function


Private Sub vascut_KeyUp(KeyCode As Integer, Shift As Integer)
Dim lrow As Long
Dim lcol As Long
    lrow = vascut.ActiveRow
    lcol = vascut.ActiveCol
    If KeyCode = vbKeyDown Then
        Call vascut_Click(lcol, lrow)
    ElseIf KeyCode = vbKeyUp Then
        Call vascut_Click(lcol, lrow)
    End If

End Sub