lds1.frm

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

        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)
            txtname.Text = rstdrv!drvname
            rstdrv.Close
            Set rstdrv = Nothing
            txtdrv.SetFocus
            Else
          SendKeys "{tab}"
          End If
    End If

End Sub

Private Sub txtname_KeyUp(KeyCode As Integer, Shift As Integer)
    If KeyCode = vbKeyReturn Then
        If txtname.Text = "" Then
        Else
          SendKeys "{tab}"
          End If
    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 = vasdrv.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
        
        rstdrv.Close
        Set rstdrv = Nothing
    Else
        
    End If
End If
End Sub

Private Sub UserControl1_ButtonClick(ByVal Button As MSComctlLib.Button)
    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 "delete"
            MsgBox "The RasCode can't be deleted!", vbExclamation, "Message"
            lblstatus.Caption = "search"
            frmlist.Enabled = False
            frminput.Enabled = True
            txtname.Enabled = False
            txtent.Text = gsEntCode
            txtdrv.Enabled = True
            txtdrv.Text = ""
            txtname.Text = ""
            txtdrv.SetFocus
                        
        Case "modify"
            lblstatus.Caption = mkey
            
        Case "close"
            Unload Me
        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 "Delete", "Delete", False, , "Delete"
                '.DisplayButton "Print", "Print", True, , "Print"
                .DisplayButton "Modify", "Modify", False, , "Modify"
                .DisplayButton "Save", "Save", True, , "Save"
                .DisplayButton "Undo", "Undo", True, , "Undo"
                .DisplayButton "Redo", "Redo", True, , "Redo"
                .DisplayButton "Close", "Close", False, , "Close"
            End With
            frmlist.Enabled = False
            frminput.Enabled = True
            txtent.Enabled = False
            txtdrv.Enabled = True
            txtdrv.SetFocus
        Case "modify"
            With UserControl1
                .DisplayButton "New", "New", False, , "New"
                .DisplayButton "Delete", "Delete", False, , "Delete"
                '.DisplayButton "Print", "Print", False, , "Print"
                .DisplayButton "Modify", "Modify", False, , "Modify"
                .DisplayButton "Save", "Save", True, , "Save"
                .DisplayButton "Undo", "Undo", True, , "Undo"
                .DisplayButton "Redo", "Redo", True, , "Redo"
                .DisplayButton "Close", "Close", False, , "Close"
            End With
            frmlist.Enabled = False
            frminput.Enabled = True
            txtent.Enabled = False
            txtdrv.Enabled = False
            txtname.Enabled = True
            txtname.SetFocus
           
        Case "undo"
            With UserControl1
                .DisplayButton "New", "New", True, , "New"
                .DisplayButton "Delete", "Delete", True, , "Delete"
                '.DisplayButton "Print", "Print", True, , "Print"
                .DisplayButton "Modify", "Modify", True, , "Modify"
                .DisplayButton "Save", "Save", False, , "Save"
                .DisplayButton "Undo", "Undo", False, , "Undo"
                .DisplayButton "Redo", "Redo", False, , "Redo"
                .DisplayButton "Close", "Close", True, , "Close"
            End With
            frmlist.Enabled = True
            frminput.Enabled = False
        Case "delete"
            With UserControl1
                .DisplayButton "New", "New", True, , "New"
                .DisplayButton "Delete", "Delete", True, , "Delete"
                '.DisplayButton "Print", "Print", True, , "Print"
                .DisplayButton "Save", "Save", False, , "Save"
                .DisplayButton "Modify", "Modify", True, , "Modify"
                .DisplayButton "Undo", "Undo", True, , "Undo"
                .DisplayButton "Redo", "Redo", False, , "Redo"
                .DisplayButton "Close", "Close", True, , "Close"
            End With
            frmlist.Enabled = False
            frminput.Enabled = True
        Case "save"
            With UserControl1
                .DisplayButton "New", "New", True, , "New"
                .DisplayButton "Delete", "Delete", True, , "Delete"
                '.DisplayButton "Print", "Print", True, , "Print"
                .DisplayButton "Save", "Save", False, , "Save"
                .DisplayButton "Modify", "Modify", True, , "Modify"
                .DisplayButton "Undo", "Undo", False, , "Undo"
                .DisplayButton "Redo", "Redo", False, , "Redo"
                .DisplayButton "Close", "Close", True, , "Close"
            End With
            frmlist.Enabled = True
            frminput.Enabled = False
        Case Else
            With UserControl1
                .DisplayButton "New", "New", True, , "New"
                .DisplayButton "Delete", "Delete", True, , "Delete"
                '.DisplayButton "Print", "Print", True, , "Print"
                .DisplayButton "Save", "Save", False, , "Save"
                .DisplayButton "Modify", "Modify", True, , "Modify"
                .DisplayButton "Undo", "Undo", False, , "Undo"
                .DisplayButton "Redo", "Redo", False, , "Redo"
                .DisplayButton "Close", "Close", True, , "Close"
            End With
            frmlist.Enabled = True
            frminput.Enabled = False
        End Select

End Sub


Private Sub IniStaDetail()
txtent.Text = gsEntCode
txtdrv.Text = ""
txtname.Text = ""

End Sub


Private Sub SavedrvInfo()

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

sent = txtent.Text
sdrv = txtdrv.Text
sname = txtname.Text

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)" & _
    "values('" & sent & "','" & sdrv & "', '" & sname & "')"
    
    Acs_cnt.Execute (sSQL)
    
    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

sdrv = txtdrv.Text
    sname = txtname.Text
    
    sSQL = "update appdrv set drvcode = '" & sdrv & "',drvname ='" & sname & "' where drvcode = '" & sdrv & "'"
    
    Acs_cnt.Execute (sSQL)

End Sub