frmtrc1.frm

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

Dim sSQL As String
Dim lrow As Long
Dim lcol As Long

sSQL = "select * from apptru order by entcode"
Set rsttru = Acs_cnt.Execute(sSQL)

With rsttru
vastru.MaxRows = 0
lrow = 0
Do While Not .EOF

    vastru.MaxRows = vastru.MaxRows + 1
    lrow = lrow + 1
    SetValue vastru, lrow, trudetail.Entcode, rsttru!Entcode
    SetValue vastru, lrow, trudetail.truckno, rsttru!truckno
    SetValue vastru, lrow, trudetail.inpdate, rsttru!inpdate
    SetValue vastru, lrow, trudetail.brgdate, rsttru!brgdate
    SetValue vastru, lrow, trudetail.enddate, rsttru!enddate
    SetValue vastru, lrow, trudetail.voldeli, rsttru!voldeli
    SetValue vastru, lrow, trudetail.volbill, rsttru!volbill
    SetValue vastru, lrow, trudetail.volrest, rsttru!volrest
    SetValue vastru, lrow, trudetail.kilomet, rsttru!kilomet
    SetValue vastru, lrow, trudetail.deltime, rsttru!deltime
    SetValue vastru, lrow, trudetail.btptime, rsttru!btptime
    SetValue vastru, lrow, trudetail.reftime, rsttru!reftime
    SetValue vastru, lrow, trudetail.wactime, rsttru!wactime
    SetValue vastru, lrow, trudetail.ishours, rsttru!ishours
    SetValue vastru, lrow, trudetail.orepare, rsttru!orepare
    SetValue vastru, lrow, trudetail.cusfill, rsttru!cusfill
    SetValue vastru, lrow, trudetail.trips, rsttru!trips
    SetValue vastru, lrow, trudetail.costcap, rsttru!costcap
    SetValue vastru, lrow, trudetail.fuelrmb, rsttru!fuelrmb
    SetValue vastru, lrow, trudetail.tollrmb, rsttru!tollrmb
    SetValue vastru, lrow, trudetail.drvcost, rsttru!drvcost
    SetValue vastru, lrow, trudetail.maicost, rsttru!maicost
.MoveNext
Loop
End With
Call vastru_Click(lCurCol, lCurRow)

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

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
        text1.Text = GetValue(vastru, Row, 1)
        Text2.Text = GetValue(vastru, Row, 2)
        Text3.Text = GetValue(vastru, Row, 3)
        Text4.Text = GetValue(vastru, Row, 4)
        Text5.Text = GetValue(vastru, Row, 5)
        Text6.Text = GetValue(vastru, Row, 6)
        Text7.Text = GetValue(vastru, Row, 7)
        Text8.Text = GetValue(vastru, Row, 8)
        Text9.Text = GetValue(vastru, Row, 9)
        Text10.Text = GetValue(vastru, Row, 10)
        Text11.Text = GetValue(vastru, Row, 11)
        Text12.Text = GetValue(vastru, Row, 12)
        Text13.Text = GetValue(vastru, Row, 13)
        Text14.Text = GetValue(vastru, Row, 14)
        Text15.Text = GetValue(vastru, Row, 15)
        Text16.Text = GetValue(vastru, Row, 16)
        Text17.Text = GetValue(vastru, Row, 17)
        Text18.Text = GetValue(vastru, Row, 18)
        Text19.Text = GetValue(vastru, Row, 19)
        Text20.Text = GetValue(vastru, Row, 20)
        Text21.Text = GetValue(vastru, Row, 21)
    Else
    End If
End If

End Sub

Private Sub txtisnumeric(txtName As TextBox, txtfocus As TextBox)


        If txtName.Text = "" Then
        txtName.Text = "0"
        SendKeys "{tab}"
        ElseIf IsNumeric(txtName.Text) Then
            SendKeys "{tab}"
            Else
            MsgBox "The input must be the numeric !!", vbExclamation, "error"
            txtfocus.SetFocus
        End If


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

    If KeyCode = vbKeyReturn Then
        If text1.Text = "" Then
        Else
            SendKeys "{tab}"
        End If
    End If
End Sub


Private Sub text2_KeyUp(KeyCode As Integer, Shift As Integer)
If KeyCode = vbKeyReturn Then
    Call txtisnumeric(Text2, text1)
End If

End Sub

Private Sub text3_KeyUp(KeyCode As Integer, Shift As Integer)
If KeyCode = vbKeyReturn Then
    Call txtisnumeric(Text3, Text2)
   End If
   
End Sub


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

If KeyCode = vbKeyReturn Then
    Call txtisnumeric(Text4, Text3)
End If
      
End Sub

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

If KeyCode = vbKeyReturn Then
    Call txtisnumeric(Text5, Text4)
End If
      
End Sub

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

If KeyCode = vbKeyReturn Then
    Call txtisnumeric(Text6, Text5)
End If
      
End Sub


Private Sub text7_KeyUp(KeyCode As Integer, Shift As Integer)
If KeyCode = vbKeyReturn Then
    Call txtisnumeric(Text7, Text6)
End If

End Sub

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

If KeyCode = vbKeyReturn Then
    Call txtisnumeric(Text8, Text7)
End If

End Sub

Private Sub text9_KeyUp(KeyCode As Integer, Shift As Integer)
  
  If KeyCode = vbKeyReturn Then
    Call txtisnumeric(Text9, Text8)
End If

End Sub


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

If KeyCode = vbKeyReturn Then
    Call txtisnumeric(Text10, Text9)
End If
      
End Sub


Private Sub text11_KeyUp(KeyCode As Integer, Shift As Integer)
If KeyCode = vbKeyReturn Then
    Call txtisnumeric(Text11, Text10)
End If

End Sub

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

If KeyCode = vbKeyReturn Then
    Call txtisnumeric(Text12, Text11)
End If

End Sub

Private Sub text13_KeyUp(KeyCode As Integer, Shift As Integer)
  
  If KeyCode = vbKeyReturn Then
    Call txtisnumeric(Text13, Text12)
    End If

End Sub
Private Sub text14_KeyUp(KeyCode As Integer, Shift As Integer)
If KeyCode = vbKeyReturn Then
    Call txtisnumeric(Text14, Text13)
End If

End Sub

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

If KeyCode = vbKeyReturn Then
    Call txtisnumeric(Text15, Text14)
End If

End Sub

Private Sub text16_KeyUp(KeyCode As Integer, Shift As Integer)
  
  If KeyCode = vbKeyReturn Then
    Call txtisnumeric(Text16, Text15)
    End If

End Sub
Private Sub text17_KeyUp(KeyCode As Integer, Shift As Integer)
If KeyCode = vbKeyReturn Then
    Call txtisnumeric(Text17, Text16)
End If

End Sub

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

If KeyCode = vbKeyReturn Then
    Text21.Text = Val(Text18.Text) + Val(Text19.Text) + Val(Text20.Text)
    Call txtisnumeric(Text18, Text17)
End If

End Sub

Private Sub text19_KeyUp(KeyCode As Integer, Shift As Integer)
  
  If KeyCode = vbKeyReturn Then
    Call txtisnumeric(Text19, Text18)
    End If

End Sub

Private Sub text20_KeyUp(KeyCode As Integer, Shift As Integer)
If KeyCode = vbKeyReturn Then
    Call txtisnumeric(Text20, Text19)
End If

End Sub

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

If KeyCode = vbKeyReturn Then
    Call txtisnumeric(Text21, Text20)
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", True, , "find"
                '.DisplayButton "Print", "Print", True, , "Print"
                .DisplayButton "Modify", "Modify", False, , "Modify"
                .DisplayButton "Save", "Save", True, , "Save"
                .DisplayButton "cancel", "cancel", True, , "cancel"
                '.DisplayButton "Redo", "Redo", True, , "Redo"
                .DisplayButton "Close", "Close", False, , "Close"
            End With
            vastru.Enabled = False
            frminput.Enabled = True
           
            
        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 "Redo", "Redo", True, , "Redo"
                .DisplayButton "Close", "Close", False, , "Close"
            End With
            vastru.Enabled = False
            frminput.Enabled = True
            text1.SetFocus
            
        Case "cancel"
            With UserControl1
                .DisplayButton "New", "New", True, , "New"
                .DisplayButton "find", "find", True, , "find"
                '.DisplayButton "Print", "Print", True, , "Print"
                .DisplayButton "Modify", "Modify", True, , "Modify"
                .DisplayButton "Save", "Save", False, , "Save"
                .DisplayButton "cancel", "cancel", False, , "cancel"
                '.DisplayButton "Redo", "Redo", False, , "Redo"
                .DisplayButton "Close", "Close", True, , "Close"
            End With
            vastru.Enabled = True
            frminput.Enabled = False
            lblstatus.Caption = ""
            Call vastru_Click(1, 1)
            
        Case "find"
            With UserControl1
                .DisplayButton "New", "New", False, , "New"
                .DisplayButton "find", "find", False, , "find"
                '.DisplayButton "Print", "Print", True, , "Print"
                .DisplayButton "Save", "Save", False, , "Save"
                .DisplayButton "Modify", "Modify", False, , "Modify"
                .DisplayButton "cancel", "cancel", True, , "cancel"
                '.DisplayButton "Redo", "Redo", True, , "Redo"
                .DisplayButton "Close", "Close", True, , "Close"
            End With
            vastru.Enabled = True
            frminput.Enabled = False
            
       Case "save"
            With UserControl1
                .DisplayButton "New", "New", True, , "New"
                .DisplayButton "find", "find", True, , "find"
                '.DisplayButton "Print", "Print", True, , "Print"
                .DisplayButton "Save", "Save", False, , "Save"
                .DisplayButton "Modify", "Modify", True, , "Modify"
                .DisplayButton "cancel", "cancel", False, , "cancel"
                '.DisplayButton "Redo", "Redo", False, , "Redo"
                .DisplayButton "Close", "Close", True, , "Close"
            End With
            vastru.Enabled = True
            frminput.Enabled = False
            
        End Select

End Sub

Private Sub IniStaDetail()
    text1.Text = ""
    Text2.Text = ""
    Text3.Text = ""
    Text4.Text = ""
    Text5.Text = ""
    Text6.Text = ""
    Text7.Text = ""
    Text8.Text = ""
    Text9.Text = ""
    Text10.Text = ""
    Text11.Text = ""
    Text12.Text = ""
    Text13.Text = ""
    Text14.Text = ""
    Text15.Text = ""
    Text16.Text = ""
    Text17.Text = ""
    Text18.Text = ""
    Text19.Text = ""
    Text20.Text = ""
    Text21.Text = ""
     
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 SavetruInfo = False Then
                    Exit Sub
                End If
                Call display
            ElseIf lblstatus.Caption = "modify" Then
                  If trumodify = False Then
                    Exit Sub
                  End If
                Call display
                     
            End If
        
        Case "find"
            lblstatus.Caption = "search"
            frminput.Enabled = False
               
          
        Case "modify"
            lblstatus.Caption = mkey
                      
        Case "close"
            
            Unload Me
       Case Else
    
    End Select
    
    Call SetToolBar(mkey)
    
End Sub

Private Function SavetruInfo() As Boolean
Dim rsttru As Recordset
Dim sSQL As String
Dim truckno As String
Dim inpdate, brgdate, enddate As Long
Dim voldeli, volbill, volrest, kilomet As Single
Dim deltime, btptime, reftime, wactime, ishours, orepare, cusfill, trips As Long
Dim costcap, fuelrmb, tollrmb, drvcost, maicost As Single
Dim flag As Boolean