⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 frmtru.frm

📁 用VB6.0编写的关于车辆运输调度的系统
💻 FRM
📖 第 1 页 / 共 4 页
字号:
        For i = 0 To Combo1.ListCount - 1
            Combo1.ListIndex = i
            If Combo1.Text = status Then
                Exit For
            End If
        Next
next1:
        
        sSQL1 = "select itedesc from appite where itecode = " & CLng(cmbite.Text)
        Set rsttru1 = Acs_cnt.Execute(sSQL1)
        If Not rsttru1.EOF Then
            txtdes.Text = rsttru1!Itedesc
        Else
            Exit Sub
        End If
        sSQL1 = "select itedesc from appite where itecode = " & CLng(cmbalt1.Text)
        Set rsttru1 = Acs_cnt.Execute(sSQL1)
        If Not rsttru1.EOF Then
            txtdes1.Text = rsttru1!Itedesc
        Else
            Exit Sub
        End If
        sSQL1 = "select itedesc from appite where itecode = " & CLng(cmbalt2.Text)
        Set rsttru1 = Acs_cnt.Execute(sSQL1)
        If Not rsttru1.EOF Then
            txtdes2.Text = rsttru1!Itedesc
        Else
            Exit Sub
        End If
        sSQL1 = "select itedesc from appite where itecode = " & CLng(cmbalt3.Text)
        Set rsttru1 = Acs_cnt.Execute(sSQL1)
        If Not rsttru1.EOF Then
            txtdes3.Text = rsttru1!Itedesc
        Else
            Exit Sub
        End If
        rsttru1.Close
        Set rsttru1 = Nothing
        Else
        
        'MsgBox "There have not this record!", vbOKOnly, "Information"
        txtentc.Text = gsEntCode
        txttruc.Text = ""
        cmbite.Text = ""
        txtmaxt.Text = ""
        txtacti.Text = ""
        cmbalt1.Text = ""
        txtmaxa1.Text = ""
        cmbalt2.Text = ""
        txtmaxa2.Text = ""
        cmbalt3.Text = ""
        txtmaxa3.Text = ""
        Combo1.ListIndex = 0
        DTPicker1.Value = Format(Now, "yyyy-mm-dd")
        txttrud.Text = ""
        txtdes.Text = ""
        txtdes1.Text = ""
        txtdes2.Text = ""
        txtdes3.Text = ""
        Check1.Value = 1
    End If
    
    Text2.SetFocus
    rsttru.Close
    Set rsttru = Nothing
End If
End Sub


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



Private Sub txtmaxa1_GotFocus()
If cmbalt1.Text = "0" Then
    txtmaxa1.Text = ""
    SendKeys "{tab}"
    End If
End Sub

Private Sub txtmaxa1_LostFocus()
    If txtmaxa1.Text = "" Then
        txtmaxa1.Text = "0"
        ElseIf IsNumeric(txtmaxa1.Text) Then
            Else
            MsgBox "The input must be the numeric !!", vbExclamation, "error"
            txtmaxa1.SetFocus
        End If
End Sub

Private Sub txtmaxa2_GotFocus()
If cmbalt2.Text = "0" Then
    txtmaxa2.Text = ""
    SendKeys "{tab}"
    End If
End Sub

Private Sub txtmaxa2_LostFocus()
    If txtmaxa2.Text = "" Then
        txtmaxa2.Text = "0"
        ElseIf IsNumeric(txtmaxa2.Text) Then
            Else
            MsgBox "The input must be the numeric !!", vbExclamation, "error"
            txtmaxa2.SetFocus
        
    End If

End Sub

Private Sub txtmaxa3_GotFocus()
If cmbalt3.Text = "0" Then
    txtmaxa3.Text = ""
    SendKeys "{tab}"
    End If
End Sub

Private Sub txtmaxa3_LostFocus()
If txtmaxa3.Text = "" Then
        txtmaxa3.Text = "0"
        ElseIf IsNumeric(txtmaxa3.Text) Then
            Else
            MsgBox "The input must be the numeric !!", vbExclamation, "error"
            txtmaxa3.SetFocus
      
    End If

End Sub

Private Sub txtmaxt_GotFocus()
 If cmbite.Text = "0" Then
    txtmaxt.Text = ""
    SendKeys "{tab}"
 End If
End Sub

Private Sub txtmaxt_LostFocus()
If txtmaxt.Text = "" Then
        txtmaxt.Text = "0"
        ElseIf IsNumeric(txtmaxt.Text) Then
            Else
            MsgBox "The input must be the numeric !!", vbExclamation, "error"
            txtmaxt.SetFocus
        End If
End Sub

Private Sub txttruc_LostFocus()
    If txttruc.Text = "" Then
        MsgBox "The truck number is no input!", vbOKOnly, "Information"
        txttruc.SetFocus
    End If
    
End Sub

Private Sub vastru_Click(ByVal Col As Long, ByVal Row As Long)
Dim truckno, Entcode As String
Dim rsttru As Recordset
Dim sSQL As String
Dim sdate As String
Dim status As String
Dim i As Long

If Row = 0 Then
Else
    frminput.Enabled = False
    With vastru
    .Col = 1
    .Row = Row
    Entcode = vastru.Text
    .Col = 2
    truckno = vastru.Text
    End With
    If Entcode <> "" And truckno <> "" Then
        txtentc.Text = gsEntCode
        txttruc.Text = GetValue(vastru, Row, 2)
        cmbite.Text = GetValue(vastru, Row, 3)
        txtmaxt.Text = GetValue(vastru, Row, 4)
        txtacti.Text = GetValue(vastru, Row, 5)
        cmbalt1.Text = GetValue(vastru, Row, 6)
        txtmaxa1.Text = GetValue(vastru, Row, 7)
        cmbalt2.Text = GetValue(vastru, Row, 8)
        txtmaxa2.Text = GetValue(vastru, Row, 9)
        cmbalt3.Text = GetValue(vastru, Row, 10)
        txtmaxa3.Text = GetValue(vastru, Row, 11)
        status = GetValue(vastru, Row, 12)
        sSQL = "select * from syssta where stacode = '" & status & "'"
        Set rsttru = Acs_cnt.Execute(sSQL)
        If Not rsttru.EOF Then
            status = rsttru!stacode & "/" & rsttru!stadesc
        Else
            MsgBox "The truck status is wrong in database!", vbOKOnly, "Error"
            GoTo next1
        End If
        For i = 0 To Combo1.ListCount - 1
            Combo1.ListIndex = i
            If Combo1.Text = status Then
                Exit For
            End If
        Next
next1:
        sdate = (GetValue(vastru, Row, 13))
        If sdate <> "" Then
            sdate = Mid(sdate, 1, 4) & "-" & Mid(sdate, 5, 2) & "-" & Mid(sdate, 7, 2)
        Else
            sdate = Format(Now, "yyyy-mm-dd")
        End If
        
        DTPicker1.Value = Format(sdate, "yyyy-mm-dd")
        Check1.Value = IIf(GetValue(vastru, Row, 15) > 0, 1, 0)
        txttrud.Text = GetValue(vastru, Row, 14)
        If cmbite.Text = "0" Then
            txtdes.Text = ""
            Else
            sSQL = "select itedesc from appite where itecode = " & CLng(cmbite.Text)
            Set rsttru = Acs_cnt.Execute(sSQL)
            If Not rsttru.EOF Then
                txtdes.Text = "" & rsttru!Itedesc
            Else
                txtdes.Text = ""
            End If
            rsttru.Close
            Set rsttru = Nothing
        End If
        If cmbalt1.Text = "0" Then
            txtdes1.Text = ""
            Else
            sSQL = "select itedesc from appite where itecode = " & CLng(cmbalt1.Text)
            Set rsttru = Acs_cnt.Execute(sSQL)
            If Not rsttru.EOF Then
                txtdes1.Text = "" & rsttru!Itedesc
            Else
                txtdes1.Text = ""
            End If
            rsttru.Close
            Set rsttru = Nothing
        End If
        If cmbalt2.Text = "0" Then
            txtdes2.Text = ""
        Else
            sSQL = "select itedesc from appite where itecode = " & CLng(cmbalt2.Text)
            Set rsttru = Acs_cnt.Execute(sSQL)
            If Not rsttru.EOF Then
                txtdes2.Text = "" & rsttru!Itedesc
            Else
                txtdes2.Text = ""
            End If
            rsttru.Close
            Set rsttru = Nothing
        End If
        If cmbalt3.Text = "0" Then
            txtdes3.Text = ""
        Else
            sSQL = "select itedesc from appite where itecode = " & CLng(cmbalt3.Text)
            Set rsttru = Acs_cnt.Execute(sSQL)
            If Not rsttru.EOF Then
                txtdes3.Text = "" & rsttru!Itedesc
            Else
                txtdes3.Text = ""
            End If
        
        rsttru.Close
        Set rsttru = Nothing
        End If
    Else
    End If
End If

End Sub

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

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

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


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

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

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

End Sub

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


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


End Sub

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

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

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

End Sub

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

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

End Sub


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

    End If
End Sub



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

     If 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 "Find", "Find", False, , "Find"
                '.DisplayButton "Print", "Print", True, , "Print"
                .DisplayButton "Modify", "Modify", False, , "Modify"
                .DisplayButton "Save", "Save", True, , "Save"
                .DisplayButton "Cancel", "Cancel", True, , "Cancel"
                .DisplayButton "Delete", "Delete", False, , "Delete"
                .DisplayButton "Close", "Close", False, , "Close"
            End With
            vastru.Enabled = False
            frminput.Enabled = True
            Text1.Visible = False
            Text2.Visible = False
            txtentc.Enabled = False
            txttruc.Enabled = True
            txttruc.SetFocus
        Case "modify"
            With UserControl1
                .DisplayButton "New", "New", False, , "New"
                .DisplayButton "Find", "Find", False, , "Find"
                '.DisplayButton "Print", "Print", False, , "Print"
                .DisplayButton "Modify", "Modify", False, , "Modify"
                .DisplayButton "Save", "Save", True, , "Save"
                .DisplayButton "Cancel", "Cancel", True, , "Cancel"
                .DisplayButton "Delete", "Delete", False, , "Delete"
                .DisplayButton "Close", "Close", False, , "Close"
            End With
            vastru.Enabled = False
            Text1.Visible = False
            Text2.Visible = False
            txtentc.Enabled = False
            txttruc.Enabled = False
            frminput.Enabled = True
            cmbite.SetFocus
        Case "cancel"
            With UserControl1
                .DisplayButton "New", "New", True, , "New"
                .DisplayButton "Find", "Find", True, , "Find"
                '.DisplayButton "Print", "Print", True, , "Print"

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -