frmcut.frm

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

Call InitToolBar
Call initcombobox
Call initspread

lCurSpdRow = 1
lCurSpdCol = 1

Call vasshow
frminput.Enabled = False

End Sub


Private Sub initcombobox()
Dim sSQL As String
Dim rstcut As Recordset

    cmbstatus.AddItem "Y"
    cmbstatus.AddItem "N"
    sSQL = "select cuscode ,cusdesc from appcus "
    Set rstcut = Acs_cnt.Execute(sSQL)
    Do While Not rstcut.EOF
        cmbcusc.AddItem (rstcut!cuscode & "/" & rstcut!Cusdesc)
        rstcut.MoveNext
    Loop
    sSQL = "select itecode,itedesc from appite where astatus ='" & "Y'"
    Set rstcut = Acs_cnt.Execute(sSQL)
    Do While Not rstcut.EOF
        cmbproc.AddItem (rstcut!Itecode & "/" & rstcut!Itedesc)
        rstcut.MoveNext
    Loop
    rstcut.Close
    Set rstcut = Nothing
     

End Sub

Private Sub initspread()
 
     With vascut
            .MaxRows = 0
            .MaxCols = 14 'enuDetailCols.MaxCols
            .ShadowColor = genuBACKCOLOR.CST_Grid_LostFocus
            .Row = -1: .Col = -1
            .BackColor = genuBACKCOLOR.CST_Grid_LostFocus
            .GridColor = vbBlack
     End With
    
     Call InitColHead
     lockspread vascut, True
                
End Sub


Private Sub InitColHead()

With vascut
 
SetColHead vascut, cutdetail.Entcode, "Entity Code", 15
SetColHead vascut, cutdetail.cuscode, "Customer Code", 15
SetColHead vascut, cutdetail.tnkcode, "Customer Tank Code", 15
SetColHead vascut, cutdetail.tnkdesc, "Tank Desc", 15, True
SetColHead vascut, cutdetail.loccode, "Customer Tank Location Code", 20
SetColHead vascut, cutdetail.procode, "Product Code", 15
SetColHead vascut, cutdetail.Meaunit, "Unit of Measurement", 20, True
SetColHead vascut, cutdetail.conveum, "Conversion UM", 15, True
SetColHead vascut, cutdetail.convfac, "Conversion Factor", 15, True
SetColHead vascut, cutdetail.physize, "Physical Size", 15, True
SetColHead vascut, cutdetail.maxleve, "Max Level", 10, True
SetColHead vascut, cutdetail.minleve, "Min Level", 10, True
SetColHead vascut, cutdetail.safleve, "Safty Level", 10, True
SetColHead vascut, cutdetail.Astatus, "Status", 8, True
End With
End Sub

Private Sub InitToolBar()
    With UserControl1
        .DisplayButton "New", "New", True, , "New"
        .DisplayButton "Save", "Save", False, , "Save"
        .DisplayButton "Cancel", "Cancel", False, , "Cancel"
        .DisplayButton "Modify", "Modify", True, , "Modify"
        .DisplayButton "Find", "Find", True, , "Find"
        .DisplayButton "Close", "Close", True, , "Close"
    End With

End Sub

Private Sub vasshow()
Dim rstcut As Recordset
Dim sSQL As String
Dim lrow As Integer

sSQL = "select * from appcut order by cuscode"
Set rstcut = Acs_cnt.Execute(sSQL)

With rstcut
vascut.MaxRows = 0
lrow = 0
Do While Not .EOF
    vascut.MaxRows = vascut.MaxRows + 1
    lrow = lrow + 1
    SetValue vascut, lrow, cutdetail.Entcode, gsEntCode
    SetValue vascut, lrow, cutdetail.cuscode, rstcut!cuscode
    SetValue vascut, lrow, cutdetail.tnkcode, rstcut!tnkcode
    SetValue vascut, lrow, cutdetail.loccode, rstcut!loccode
    SetValue vascut, lrow, cutdetail.procode, rstcut!procode
    SetValue vascut, lrow, cutdetail.tnkdesc, "" & rstcut!tnkdesc
    SetValue vascut, lrow, cutdetail.Meaunit, rstcut!Meaunit
    SetValue vascut, lrow, cutdetail.conveum, rstcut!conveum
    SetValue vascut, lrow, cutdetail.convfac, rstcut!convfac
    SetValue vascut, lrow, cutdetail.physize, rstcut!physize
    SetValue vascut, lrow, cutdetail.maxleve, "" & rstcut!maxleve
    SetValue vascut, lrow, cutdetail.minleve, "" & rstcut!minleve
    SetValue vascut, lrow, cutdetail.safleve, "" & rstcut!safleve
    SetValue vascut, lrow, cutdetail.Astatus, "" & rstcut!Astatus

.MoveNext
Loop
End With
rstcut.Close
Set rstcut = Nothing

Call vascut_Click(lCurSpdCol, lCurSpdRow)

End Sub

Private Sub txtconf_LostFocus()

    If txtconf.Text = "" Then
    txtconf.Text = "0"
    Else
        If IsNumeric(txtconf.Text) Then
        Else
            MsgBox "The input must be numeric!", vbOKOnly, "Information"
            txtconf.SetFocus
        End If
    End If
End Sub

Private Sub txtmaxl_LostFocus()

    If txtmaxl.Text = "" Then
        txtmaxl.Text = "0"
    Else
        If IsNumeric(txtmaxl.Text) Then
        Else
            MsgBox "The input must be numeric!", vbOKOnly, "Information"
            txtmaxl.SetFocus
        End If
    End If
End Sub

Private Sub txtminl_LostFocus()

    If txtminl.Text = "" Then
        txtminl.Text = "0"
    Else
        If IsNumeric(txtminl.Text) Then
        Else
            MsgBox "The input must be numeric!", vbOKOnly, "Information"
            txtminl.SetFocus
        End If
    End If
End Sub

Private Sub txtphys_LostFocus()

    If txtphys.Text = "" Then
        txtphys.Text = "0"
    Else
        If IsNumeric(txtphys.Text) Then
        Else
            MsgBox "The input must be numeric!", vbOKOnly, "Information"
            txtphys.SetFocus
        End If
    End If
End Sub

Private Sub txtsafl_LostFocus()
    
    If txtsafl.Text = "" Then
        txtsafl.Text = "0"
    Else
        If IsNumeric(txtsafl.Text) Then
        Else
            MsgBox "The input must be numeric!", vbOKOnly, "Information"
            txtsafl.SetFocus
        End If
    End If
End Sub

Private Sub txttnkc_LostFocus()
Dim cuscode As Long
Dim tnkcode As Long
Dim sSQL As String
Dim rstcut As Recordset
        If lblstatus.Caption = "search" Then
            If IsNumeric(txttnkc.Text) Then
            cuscode = CLng(getstr(cmbcusc.Text, "/"))
            tnkcode = CLng(txttnkc.Text)
            sSQL = "select * from appcut where cuscode = " & cuscode & "and tnkcode =" & tnkcode & ""
            Set rstcut = Acs_cnt.Execute(sSQL)
            If Not rstcut.EOF Then
                
                cmbcusc.Text = rstcut!cuscode
                txttnkc.Text = rstcut!tnkcode
                txtlocc.Text = rstcut!loccode
                cmbproc.Text = rstcut!procode
                txttnkd.Text = rstcut!tnkdesc
                txtmeau.Text = rstcut!Meaunit
                txtconv.Text = rstcut!conveum
                txtconf.Text = rstcut!convfac
                txtphys.Text = rstcut!physize
                txtmaxl.Text = rstcut!maxleve
                txtminl.Text = rstcut!minleve
                txtsafl.Text = rstcut!safleve
                If cmbcusc.Text = "0" Then
                    txtcusd.Text = ""
                Else
                    sSQL = "select cusdesc from appcus where cuscode =" & CLng(cmbcusc.Text)
                    Set rstcut = Acs_cnt.Execute(sSQL)
                    txtcusd.Text = rstcut!Cusdesc
                    rstcut.Close
                    Set rstcut = Nothing
                End If
                If cmbproc.Text = "0" Then
                    cmbproc.Text = ""
                Else
                    sSQL = "select itedesc from appite where itecode = " & CLng(cmbproc.Text)
                    Set rstcut = Acs_cnt.Execute(sSQL)
                    txtprod.Text = rstcut!Itedesc
                    rstcut.Close
                    Set rstcut = Nothing
                End If
                cmbcusc.SetFocus
            Else
                MsgBox "The record is not exist!", vbOKOnly, "Information"
                cmbcusc.SetFocus
            End If
            
        Else
            If IsNumeric(txttnkc.Text) Then
            Else
            MsgBox "The input must be numeric", vbOKOnly, "Information"
            txttnkc.SetFocus
            End If
        End If
        End If
End Sub

Private Sub txttnkd_KeyDown(KeyCode As Integer, Shift As Integer)
    If KeyCode = vbKeyReturn Then
        SendKeys "{tab}"
    End If
End Sub

Private Sub vascut_Click(ByVal Col As Long, ByVal Row As Long)
Dim cutckno, Entcode As String
Dim rstcut As Recordset
Dim sSQL As String
Dim status As String
Dim i As Long
If Row = 0 Then
Else
    frminput.Enabled = False
    With vascut
    .Row = Row
    .Col = 2
    cutckno = vascut.Text
    End With
    If cutckno <> "" Then
        txtentc.Text = gsEntCode
        cmbcusc.Text = GetValue(vascut, Row, 2)
        txttnkc.Text = GetValue(vascut, Row, 3)
        txttnkd.Text = GetValue(vascut, Row, 4)
        txtlocc.Text = GetValue(vascut, Row, 5)
        cmbproc.Text = GetValue(vascut, Row, 6)
        txtmeau.Text = GetValue(vascut, Row, 7)
        txtconv.Text = GetValue(vascut, Row, 8)
        txtconf.Text = GetValue(vascut, Row, 9)
        txtphys.Text = GetValue(vascut, Row, 10)
        txtmaxl.Text = GetValue(vascut, Row, 11)
        txtminl.Text = GetValue(vascut, Row, 12)
        txtsafl.Text = GetValue(vascut, Row, 13)
        status = GetValue(vascut, Row, 14)
        For i = 0 To cmbstatus.ListCount - 1
            cmbstatus.ListIndex = i
            If cmbstatus.Text = status Then
            Exit For
            End If
        Next
        If cmbcusc.Text = "0" Then
            txtcusd.Text = ""
        Else
            sSQL = "select cusdesc from appcus where cuscode =" & CLng(cmbcusc.Text)
            Set rstcut = Acs_cnt.Execute(sSQL)
            txtcusd.Text = rstcut!Cusdesc
            rstcut.Close
            Set rstcut = Nothing
        End If
        If cmbproc.Text = "0" Then
            cmbproc.Text = ""
        Else
            sSQL = "select itedesc from appite where itecode = " & CLng(cmbproc.Text)
            Set rstcut = Acs_cnt.Execute(sSQL)
            txtprod.Text = rstcut!Itedesc
            rstcut.Close
            Set rstcut = Nothing
        End If
        
        lCurSpdRow = vascut.Row
        lCurSpdCol = vascut.Col
    Else
    End If
End If
End Sub

Private Sub txttnkc_Keydown(KeyCode As Integer, Shift As Integer)

    If KeyCode = vbKeyReturn Then
       SendKeys "{tab}"
    End If


End Sub

Private Sub cmbproc_KeyDown(KeyCode As Integer, Shift As Integer)

If KeyCode = vbKeyReturn Then
    SendKeys "{tab}"
End If

End Sub

Private Sub txtconf_KeyDown(KeyCode As Integer, Shift As Integer)

    If KeyCode = vbKeyReturn Then
        SendKeys "{tab}"
'    If IsNumeric(txtconf.Text) Then
'    Else
'        MsgBox "The input must be numeric!", vbOKOnly, "Information"
'        txtconf.SetFocus
'    End If
    End If
    
End Sub

Private Sub txtphys_KeyDown(KeyCode As Integer, Shift As Integer)

    If KeyCode = vbKeyReturn Then
        SendKeys "{tab}"
'    If IsNumeric(txtphys.Text) Then
'    Else
'        MsgBox "The input must be numeric!", vbOKOnly, "Information"
'        txtphys.SetFocus
'    End If
    End If
    
End Sub

Private Sub txtmaxl_KeyDown(KeyCode As Integer, Shift As Integer)

    If KeyCode = vbKeyReturn Then
        SendKeys "{tab}"
'         If IsNumeric(txtmaxl.Text) Then
'    Else
'        MsgBox "The input must be numeric!", vbOKOnly, "Information"
'        txtmaxl.SetFocus
'    End If
    End If
    
End Sub

Private Sub txtminl_KeyDown(KeyCode As Integer, Shift As Integer)

    If KeyCode = vbKeyReturn Then
        SendKeys "{tab}"
'         If IsNumeric(txtminl.Text) Then
'    Else
'        MsgBox "The input must be numeric!", vbOKOnly, "Information"
'        txtminl.SetFocus
'    End If
    End If
    
End Sub


Private Sub txtsafl_Keydown(KeyCode As Integer, Shift As Integer)

    If KeyCode = vbKeyReturn Then
        SendKeys "{tab}"
'    If IsNumeric(txtsafl.Text) Then
'    Else
'        MsgBox "The input must be numeric!", vbOKOnly, "Information"
'        txtsafl.SetFocus
'    End If
    End If
    
End Sub

Private Sub txtlocc_keydown(KeyCode As Integer, Shift As Integer)

    If KeyCode = vbKeyReturn Then
        If txtlocc.Text = "" Then
            txtlocc.Text = "0"
        Else
          SendKeys "{tab}"
        End If
    End If

End Sub
Private Sub txtprod_keyDown(KeyCode As Integer, Shift As Integer)

    If txtprod.Text = "" Then
        ElseIf KeyCode = vbKeyReturn Then
          SendKeys "{tab}"
    End If

End Sub

Private Sub txtmeau_keydown(KeyCode As Integer, Shift As Integer)

    If txtmeau.Text = "" Then
        ElseIf KeyCode = vbKeyReturn Then
          SendKeys "{tab}"
    End If

End Sub

Private Sub txtconv_keydown(KeyCode As Integer, Shift As Integer)

    If txtconv.Text = "" Then
        ElseIf KeyCode = vbKeyReturn Then
          SendKeys "{tab}"
    End If

End Sub

Private Sub SetToolBar(ByVal mkey As String)
        Select Case mkey
        Case "new"
            With UserControl1
                .DisplayButton "New", "New", False, , "New"
                .DisplayButton "Modify", "Modify", False, , "Modify"
                .DisplayButton "Save", "Save", True, , "Save"
                .DisplayButton "Cancel", "Cancel", True, , "Cancel"
                .DisplayButton "Find", "Find", False, , "Find"
                .DisplayButton "Close", "Close", False, , "Close"
            End With
            vascut.Enabled = False
            frminput.Enabled = True
            txtentc.Enabled = False
            cmbcusc.Enabled = True
            txttnkc.Enabled = True
            cmbstatus.SetFocus
            
        Case "modify"
            With UserControl1
                .DisplayButton "New", "New", False, , "New"
                .DisplayButton "Find", "Find", False, , "Find"
                .DisplayButton "Modify", "Modify", False, , "Modify"
                .DisplayButton "Save", "Save", True, , "Save"
                .DisplayButton "Cancel", "Cancel", True, , "Cancel"
                .DisplayButton "Close", "Close", False, , "Close"