frmtripcosting.frm

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

        Set ItemX = lsvTrips.ListItems.Add(, "K" & iCount, .Fields("tripsno"))
        ItemX.SubItems(1) = .Fields("truckno")
        ItemX.SubItems(2) = .Fields("driver1")
        ItemX.SubItems(3) = .Fields("drvname1")
        ItemX.SubItems(4) = "" & .Fields("driver2")
        ItemX.SubItems(5) = "" & .Fields("drvname2")
        ItemX.SubItems(6) = "" & .Fields("guarder")
        .MoveNext
    Loop
    End With
    
    rstTrips.Close
    Set rstTrips = Nothing
    
    If lsvTrips.ListItems.Count > 0 Then
        lsvTrips.ListItems(1).Selected = True
        lTripsNo = lsvTrips.SelectedItem.Text
        Call RefershRecord(lTripsNo)
    End If
    
End Sub


Private Sub RefershRecord(ByVal lTripsNo As Long)
Dim sSQL As String
Dim rstRecords As Recordset, rstCost As Recordset, rstTripsInfo As Recordset
Dim ItemX As ListItem
Dim iCount As Long

   
    lsvRecords.ListItems.Clear
    sSQL = "select * from ttosta where tripsno=" & lTripsNo & " "
    Set rstRecords = Acs_cnt.Execute(sSQL)
    
    iCount = 1
    With rstRecords
    Do While Not .EOF
        Set ItemX = lsvRecords.ListItems.Add(, "K" & iCount, iCount)
        ItemX.SubItems(1) = .Fields("deliqty")
        ItemX.SubItems(2) = .Fields("kilomet")
        ItemX.SubItems(3) = .Fields("ID")
        ItemX.SubItems(4) = .Fields("costcap")
        ItemX.SubItems(5) = .Fields("fuelrmb")
        ItemX.SubItems(6) = .Fields("tollrmb")
        ItemX.SubItems(7) = .Fields("drvcost")
        ItemX.SubItems(8) = .Fields("maicost")
        iCount = iCount + 1
        .MoveNext
    Loop
    End With
    
'    sSQL = "select sum(costcap) as costcap,sum(fuelrmb) as fulrmb,sum(tollrmb) as tollrmb,sum(drvcost) as drvcost,sum(maicost) as maicost from ttosta where tripsno=" & lTripsNo & " "
'    Set rstCost = Acs_cnt.Execute(sSQL)
'    With rstCost
'        txtcostcap.Text = SetText(rstCost!costcap)
'        txtfuel.Text = SetText(rstCost!fulrmb)
'        txttoll.Text = SetText(rstCost!tollrmb)
'        txtdrvcost.Text = SetText(rstCost!drvcost)
'        txtmaicost.Text = SetText(rstCost!maicost)
'    End With
'
    sSQL = "select * from triphead where tripsno=" & lTripsNo & ""
    Set rstTripsInfo = Acs_cnt.Execute(sSQL)
    With rstTripsInfo
    Do While Not .EOF
        If .Fields("deldate") > 0 Then
            DTPicker1.Value = LongToDate(.Fields("deldate"))
        End If
        DTPicker2.Value = IIf(IsNull(.Fields("deltime")), "00:00:00", .Fields("deltime"))
        If .Fields("btpdate") > 0 Then
            DTPicker3.Value = LongToDate(.Fields("btpdate"))
        Else
        End If
        DTPicker4.Value = IIf(IsNull(.Fields("btptime")), "00:00:00", .Fields("btptime"))
    
        txtreful.Text = SetText(.Fields("reftime"))
        txtwait.Text = SetText(.Fields("wactime"))
        txtinserv.Text = SetText(.Fields("ishours"))
        txtoutofserv.Text = SetText(.Fields("orepare"))
               
        txtddeliqty.Text = SetText(.Fields("voldeli"))
        txtvolrest.Text = SetText(.Fields("volrest"))
        txtbegkilo.Text = SetText(.Fields("begkilo"))
        txtendkilo.Text = SetText(.Fields("endkilo"))
        
        txtcostcap.Text = SetText(.Fields("costcap"))
        txtfuel.Text = SetText(.Fields("fuelrmb"))
        txttoll.Text = SetText(.Fields("tollrmb"))
        txtdrvcost.Text = SetText(.Fields("drvcost"))
        txtmaicost.Text = SetText(.Fields("maicost"))
        Label20.Caption = .Fields("meaunit")
        Label21.Caption = .Fields("meaunit")
        .MoveNext
    Loop
    End With
    
    
    rstRecords.Close
'    rstCost.Close
    rstTripsInfo.Close
    
    Set rstRecords = Nothing
'    Set rstCost = Nothing
    Set rstTripsInfo = Nothing
    
End Sub

Private Sub lsvTrips_ItemClick(ByVal Item As MSComctlLib.ListItem)
    
    lTripsNo = lsvTrips.SelectedItem.Text
    Call RefershRecord(lTripsNo)

End Sub

Private Sub txtfuel_KeyPress(KeyAscii As Integer)
Dim sStr As String

    sStr = txtfuel.Text

    KeyAscii = TxtAscii(sStr, KeyAscii)
End Sub

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

Private Sub txtdrvcost_KeyPress(KeyAscii As Integer)
Dim sStr As String

    sStr = txtdrvcost.Text

    KeyAscii = TxtAscii(sStr, KeyAscii)
End Sub

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

Private Sub txtcostcap_KeyPress(KeyAscii As Integer)
Dim sStr As String

    sStr = txtcostcap.Text

    KeyAscii = TxtAscii(sStr, KeyAscii)
End Sub

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

Private Sub txtmaicost_KeyPress(KeyAscii As Integer)
 Dim sStr As String

    sStr = txtmaicost.Text

    KeyAscii = TxtAscii(sStr, KeyAscii)
End Sub

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

Private Sub txtoutofserv_KeyPress(KeyAscii As Integer)
 Dim sStr As String

    sStr = txtoutofserv.Text

    KeyAscii = TxtAscii(sStr, KeyAscii)
    
End Sub

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

Private Sub txtreful_KeyPress(KeyAscii As Integer)
 Dim sStr As String

    sStr = txtreful.Text

    KeyAscii = TxtAscii(sStr, KeyAscii)
    
End Sub

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

Private Sub txttoll_KeyPress(KeyAscii As Integer)
 Dim sStr As String

    sStr = txttoll.Text

    KeyAscii = TxtAscii(sStr, KeyAscii)

End Sub


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

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

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

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

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



Private Function SetText(ByVal dnumeric As Double) As String

    SetText = IIf(dnumeric = 0, "", dnumeric)

End Function


Private Sub txtbegkilo_KeyPress(KeyAscii As Integer)
Dim sStr As String

    sStr = txtbegkilo.Text

    KeyAscii = TxtAscii(sStr, KeyAscii)
End Sub

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

Private Sub txtendkilo_KeyPress(KeyAscii As Integer)
Dim sStr As String

    sStr = txtendkilo.Text

    KeyAscii = TxtAscii(sStr, KeyAscii)
End Sub

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

Private Sub txtinserv_KeyPress(KeyAscii As Integer)
Dim sStr As String

    sStr = txtinserv.Text

    KeyAscii = TxtAscii(sStr, KeyAscii)
End Sub

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

Private Sub txtddeliqty_KeyPress(KeyAscii As Integer)
Dim sStr As String

    sStr = txtddeliqty.Text

    KeyAscii = TxtAscii(sStr, KeyAscii)
    
End Sub

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

Private Sub txttripno_KeyUp(KeyCode As Integer, Shift As Integer)
    If KeyCode = vbKeyReturn Then
        lTripsNo = IIf(IsNumeric(txttripno.Text), txttripno.Text, 0)
        If lTripsNo > 0 Then
            Call setTrips(lTripsNo)
        End If
    End If
    
End Sub

Private Sub txtvolrest_KeyPress(KeyAscii As Integer)
Dim sStr As String

    sStr = txtvolrest.Text

    KeyAscii = TxtAscii(sStr, KeyAscii)
End Sub

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

Private Sub txtwait_KeyPress(KeyAscii As Integer)
Dim sStr As String

    sStr = txtwait.Text

    KeyAscii = TxtAscii(sStr, KeyAscii)
    
End Sub

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

Private Function ChgDouble(ByVal sText As String) As Double

    ChgDouble = IIf(sText = "", 0, sText)
    
End Function