frmdrv.frm

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

        sent = txtent.Text
        sdrv = txtdrv.Text
        sSQL = "select * from appdrv where entcode = '" & sent & "'and drvcode = '" & sdrv & "'"
        Set rstdrv = Acs_cnt.Execute(sSQL)
        If Not rstdrv.EOF Then
            txtName.Text = rstdrv!drvname
            txtqual.Text = rstdrv!qualify
        Else
            MsgBox "There haven't this record!"
            txtdrv.SetFocus
        End If
        rstdrv.Close
        Set rstdrv = Nothing
        txtdrv.SetFocus
    End If
    Else
    SendKeys "{tab}"
    End If

End If

End Sub



Private Sub txtdrv_LostFocus()
'Dim rstdrv As Recordset
'Dim sSQL As String
'Dim sent, sdrv As String
'
'    If txtdrv.Text = "" Then
'       MsgBox "The drver code is not input", vbOKOnly, "Information"
'       txtdrv.SetFocus
'    ElseIf lblstatus.Caption = "search" Then
'        sent = txtent.Text
'        sdrv = txtdrv.Text
'        sSQL = "select * from appdrv where entcode = '" & sent & "'and drvcode = '" & sdrv & "'"
'        Set rstdrv = Acs_cnt.Execute(sSQL)
'        If Not rstdrv.EOF Then
'            txtname.Text = rstdrv!drvname
'            txtqual.Text = rstdrv!qualify
'        Else
'            MsgBox "There haven't this record!"
'            txtdrv.SetFocus
'        End If
'        rstdrv.Close
'        Set rstdrv = Nothing
'        txtdrv.SetFocus
'    End If

End Sub

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

End Sub

Private Sub txtname_LostFocus()
    If txtName.Text = "" Then
        MsgBox "The drver name is not input!", vbOKOnly, "Information"
        txtName.SetFocus
    End If
End Sub

Private Sub vasdrv_Click(ByVal Col As Long, ByVal Row As Long)
Dim drvcode As String
Dim rstdrv As Recordset
Dim sSQL As String

If Row = 0 Then

Else
    frminput.Enabled = False
    With vasdrv
    .Col = 2
    .Row = Row
    drvcode = .Text
    End With
    
    If drvcode <> "" Then
    
        sSQL = "select * from appdrv where drvcode = '" & drvcode & "'"
        Set rstdrv = Acs_cnt.Execute(sSQL)
        
        txtent.Text = gsEntCode
        txtdrv.Text = rstdrv!drvcode
        txtName.Text = rstdrv!drvname
        txtqual.Text = "" & rstdrv!qualify
        Check1.Value = IIf(rstdrv!availab > 0, 1, 0)
        
        rstdrv.Close
        Set rstdrv = Nothing
    Else
        
    End If
End If
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
                Call SavedrvInfo
                Call vasshow
            ElseIf lblstatus.Caption = "modify" Then
                Call drvmodify
                Call vasshow
            End If
        
        Case "find"
            lblstatus.Caption = "search"
        Case "delete"
            If MsgBox("Are you sure to delete this record?", vbYesNo, "Message") = vbYes Then
                Call delinfo
                Call vasshow
                Call vasdrv_Click(1, 1)
            Else
                Exit Sub
            End If
        Case "cancel"
            Call vasdrv_Click(vasdrv.ActiveCol, vasdrv.ActiveRow)
        Case "modify"
            lblstatus.Caption = mkey
            
        Case "close"
            Unload Me
            Exit Sub
        Case Else
    
    End Select
    
    Call SetToolBar(mkey)
    
End Sub


Private Sub SetToolBar(ByVal mkey As String)
        Select Case mkey
        Case "new"
            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"
            End With
            vasdrv.Enabled = False
            frminput.Enabled = True
            txtent.Enabled = False
            txtName.Enabled = True
            txtqual.Enabled = True
            txtdrv.Enabled = True
            txtdrv.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"
            End With
            vasdrv.Enabled = False
            frminput.Enabled = True
            txtent.Enabled = False
            txtdrv.Enabled = False
            txtName.Enabled = True
            txtqual.Enabled = True
            txtName.Enabled = True
            txtName.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
            vasdrv.Enabled = True
            frminput.Enabled = False
            lblstatus.Caption = ""
        Case "find"
            With UserControl1
                .DisplayButton "New", "New", False, , "New"
                .DisplayButton "Find", "Find", False, , "Find"
                
                .DisplayButton "Save", "Save", False, , "Save"
                .DisplayButton "Modify", "Modify", False, , "Modify"
                .DisplayButton "Cancel", "Cancel", True, , "Cancel"
                
                .DisplayButton "Close", "Close", True, , "Close"
            End With
            vasdrv.Enabled = False
            frminput.Enabled = True
            txtName.Enabled = False
            txtqual.Enabled = False
            txtent.Text = gsEntCode
            txtdrv.Enabled = True
            txtdrv.Text = ""
            txtName.Text = ""
            txtdrv.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
            vasdrv.Enabled = True
            frminput.Enabled = False
        Case "delete"
             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
            vasdrv.Enabled = True
            frminput.Enabled = False
            
        End Select

End Sub


Private Sub IniStaDetail()
txtent.Text = gsEntCode
txtdrv.Text = ""
txtName.Text = ""
txtqual.Text = ""
Check1.Value = 1

End Sub

Private Sub delinfo()
Dim sSQL As String
Dim sdrvcode As String
    sdrvcode = txtdrv.Text
    sSQL = "delete from appdrv where drvcode = '" & sdrvcode & "'"
    Acs_cnt.BeginTrans
    Acs_cnt.Execute (sSQL)
    Acs_cnt.CommitTrans
    
End Sub



Private Sub SavedrvInfo()

Dim rstdrv As Recordset
Dim sSQL As String
Dim sent, sdrv, sname As String
Dim flag As Boolean
Dim qualify As String
Dim check As Long

sent = gsEntCode
sdrv = txtdrv.Text
sname = txtName.Text
qualify = txtqual.Text
check = IIf(Check1.Value, 1, 0)
flag = txtent.Text <> "" And txtdrv.Text <> "" And txtName.Text <> ""

If flag Then
    sSQL = "select * from appdrv where drvcode='" & sdrv & "'"
    Set rstdrv = Acs_cnt.Execute(sSQL)
    With rstdrv
    If Not .EOF Then
        MsgBox "This StaCode is exist,please change the drvcode!", vbInformation, "Error"
        Exit Sub
    End If
    End With
    
    sSQL = "insert into appdrv (entcode, drvcode, drvname, qualify,availab)" & _
    "values('" & sent & "','" & sdrv & "', '" & sname & "','" & qualify & "'," & check & ")"
    Acs_cnt.BeginTrans
    Acs_cnt.Execute (sSQL)
    Acs_cnt.CommitTrans
    rstdrv.Close
    Set rstdrv = Nothing
    vasdrv.MaxRows = vasdrv.MaxRows + 1
Else
MsgBox "One or Some items are not input!", vbExclamation, "Error"
End If

End Sub

Private Sub drvmodify()
Dim rsttru As Recordset
Dim sSQL As String
Dim sdrv, sname As String
Dim qualify As String
Dim check As Long
    sdrv = txtdrv.Text
    sname = txtName.Text
    qualify = txtqual.Text
    check = IIf(Check1.Value, 1, 0)
    sSQL = "update appdrv set drvname ='" & sname & "',Qualify = '" & qualify & "',availab = " & check & " where drvcode = '" & sdrv & "'"
    Acs_cnt.BeginTrans
    Acs_cnt.Execute (sSQL)
    Acs_cnt.CommitTrans
End Sub

Private Sub vasdrv_KeyUp(KeyCode As Integer, Shift As Integer)
Dim lrow, lcol As Long
    lrow = vasdrv.ActiveRow
    lcol = vasdrv.ActiveCol
    
    If KeyCode = vbKeyUp Or KeyCode = vbKeyDown Then
        Call vasdrv_Click(lcol, lrow)
    End If
End Sub