frmtripcosting.frm

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

         Width           =   1935
      End
      Begin VB.Label lblbegkilo 
         Caption         =   "Begin Kilometers(KM)"
         Height          =   255
         Left            =   360
         TabIndex        =   34
         Top             =   1920
         Width           =   2175
      End
      Begin VB.Label Label16 
         Caption         =   "End Kilometers(KM)"
         Height          =   255
         Left            =   5040
         TabIndex        =   33
         Top             =   1870
         Width           =   1935
      End
      Begin VB.Label Label15 
         Caption         =   "Volume Loaded"
         Height          =   255
         Left            =   960
         TabIndex        =   32
         Top             =   1587
         Width           =   1455
      End
      Begin VB.Label Label17 
         AutoSize        =   -1  'True
         Height          =   210
         Left            =   3600
         TabIndex        =   31
         Top             =   1680
         Width           =   105
      End
      Begin VB.Label Label19 
         AutoSize        =   -1  'True
         Height          =   210
         Left            =   1680
         TabIndex        =   30
         Top             =   -3480
         Width           =   105
      End
      Begin VB.Label Label8 
         AutoSize        =   -1  'True
         Caption         =   "Toll Cost(RMB)"
         Height          =   210
         Left            =   960
         TabIndex        =   29
         Top             =   2586
         Width           =   1470
      End
      Begin VB.Label Label9 
         Caption         =   "Fuel Costs(Liter)"
         Height          =   255
         Left            =   720
         TabIndex        =   28
         Top             =   2253
         Width           =   1815
      End
      Begin VB.Label Label12 
         Caption         =   "Maintenance Cost(RMB)"
         Height          =   255
         Left            =   240
         TabIndex        =   27
         Top             =   2880
         Width           =   2295
      End
      Begin VB.Label Label11 
         Caption         =   "Driver Cost(RMB)"
         Height          =   255
         Left            =   5280
         TabIndex        =   26
         Top             =   2520
         Width           =   1695
      End
      Begin VB.Label Label10 
         Caption         =   "Fuel Costs(RMB)"
         Height          =   255
         Left            =   5400
         TabIndex        =   25
         Top             =   2193
         Width           =   1575
      End
      Begin VB.Label Label6 
         AutoSize        =   -1  'True
         Height          =   210
         Left            =   8160
         TabIndex        =   24
         Top             =   1560
         Width           =   105
      End
   End
   Begin VB.Label Label22 
      Caption         =   "Trips Number"
      Height          =   255
      Left            =   240
      TabIndex        =   50
      Top             =   240
      Width           =   1335
   End
End
Attribute VB_Name = "frmTripCosting"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Option Base 1
Public lTripsNo As Long

Private Sub iniTrips()
    
    With lsvTrips
        .View = lvwReport
        .FullRowSelect = True
        .MultiSelect = False
        .LabelEdit = lvwManual
        
        .ColumnHeaders.Add , "K1", "Trip No", 1000
        .ColumnHeaders.Add , "K2", "Truck No", 1200
        .ColumnHeaders.Add , "K3", "Driver1", 1300
        .ColumnHeaders.Add , "K4", "Driver1 Name", 1500
        .ColumnHeaders.Add , "K5", "Driver2", 1300
        .ColumnHeaders.Add , "K6", "Driver2 Name", 1500
        .ColumnHeaders.Add , "K7", "Guarder", 1300

    End With
    
End Sub

Private Sub iniRecords()
    
    With lsvRecords
        .View = lvwReport
        .FullRowSelect = True
        .MultiSelect = False
        .LabelEdit = lvwManual
        
        .ColumnHeaders.Add , "K1", "No.", 500
        .ColumnHeaders.Add , "K2", "Delivered Qty", 1800
        .ColumnHeaders.Add , "K3", "Kilometer", 1200
        .ColumnHeaders.Add , "K4", "ID", 0
        .ColumnHeaders.Add , "K5", "Fuel Cost(Liter)", 2000
        .ColumnHeaders.Add , "K6", "Fuel Cost(RMB)", 1800
        .ColumnHeaders.Add , "K7", "Toll Cost", 1600
        .ColumnHeaders.Add , "K8", "Driver Cost", 1600
        .ColumnHeaders.Add , "K9", "Maintenance Cost", 2000

    End With
    
End Sub


Private Sub cmdCancel_Click()

    cmdmodify.Enabled = True
    cmdSave.Enabled = False
    If lsvTrips.ListItems.Count > 0 Then
        lsvTrips.ListItems(1).Selected = True
        Call lsvTrips_ItemClick(lsvTrips.ListItems.Item(1))
    End If
    lsvTrips.SetFocus
End Sub

Private Sub cmdclose_Click()
    Unload Me
End Sub

Private Sub cmdmodify_Click()
    Frame3.Enabled = True
    cmdmodify.Enabled = False
    cmdSave.Enabled = True
End Sub

Private Sub cmdSave_Click()
On Error GoTo err
Dim dcostcap() As Double, dfuelcost() As Double, dtollcost() As Double, ddrvcost() As Double, dmaicost() As Double
Dim costcap As Double, fuelcost As Double, tollcost As Double, drvcost As Double, maicost As Double
Dim sSQL1 As String, sSQL2 As String, i As Long, lRecordCount As Long
Dim ddeliqty() As Double, dkilomet() As Double, lID() As Long
Dim sumValue As Double, Value() As Double
Dim tDelTime As Date, tBtpTime As Date
Dim lDelDate As Long, lBtpDate As Long
Dim dreftime As Double, dwactime As Double, dishours As Double, dorepare As Double
Dim dbegkilo As Double, dendkilo As Double, dvolrest As Double
Dim voldeli As Double, volrest As Double
Dim SumDeliQty As Double
Dim lTripDate2 As Long

        lDelDate = ChangeDate(DTPicker1.Value)
        tDelTime = DTPicker2.Value
        lBtpDate = ChangeDate(DTPicker3.Value)
        tBtpTime = DTPicker4.Value
        
        lTripDate2 = ChangeDate(Date)
        
        If lBtpDate < lDelDate Then
            MsgBox "End Date can't less than Begin Date!"
            Exit Sub
        End If
    
        If lBtpDate = lDelDate Then
            If tBtpTime < tDelTime Then
                MsgBox "Back to Plant Time can't less than Delivery Time!"
                Exit Sub
            End If
        End If
        
        
        dreftime = ChgDouble(txtreful.Text)
        dwactime = ChgDouble(txtwait.Text)
        dishours = ChgDouble(txtinserv.Text)
        dorepare = ChgDouble(txtoutofserv.Text)
        
        If (dreftime + dwactime + dishours + dorepare) > (DTPicker3.Value - DTPicker1.Value) * 24 + (DTPicker4.Value - DTPicker2.Value) * 24 Then
            MsgBox "Time has some error!", vbOKOnly, "Message"
            Exit Sub
        End If
    
        dbegkilo = ChgDouble(txtbegkilo.Text)
        dendkilo = ChgDouble(txtendkilo.Text)
        
        voldeli = ChgDouble(txtddeliqty.Text)
        volrest = ChgDouble(txtvolrest.Text)
        
    lRecordCount = lsvRecords.ListItems.Count
    
    ReDim dcostcap(lRecordCount) As Double
    ReDim dfuelcost(lRecordCount) As Double
    ReDim dtollcost(lRecordCount) As Double
    ReDim ddrvcost(lRecordCount) As Double
    ReDim dmaicost(lRecordCount) As Double
    ReDim ddeliqty(lRecordCount) As Double
    ReDim dkilomet(lRecordCount) As Double
    ReDim Value(lRecordCount) As Double
    ReDim centValue(lRecordCount) As Double
    ReDim lID(lRecordCount) As Long
    
    sumValue = 0
    SumDeliQty = 0
    For i = 1 To lRecordCount
        ddeliqty(i) = lsvRecords.ListItems(i).SubItems(1)
        dkilomet(i) = lsvRecords.ListItems(i).SubItems(2)
        lID(i) = lsvRecords.ListItems(i).SubItems(3)
        SumDeliQty = SumDeliQty + ddeliqty(i)
        Value(i) = ddeliqty(i) * dkilomet(i)
        sumValue = sumValue + Value(i)
    Next i
    
    costcap = txtcostcap.Text
    fuelcost = txtfuel.Text
    tollcost = txttoll.Text
    drvcost = txtdrvcost.Text
    maicost = txtmaicost.Text

    dcostcap(lRecordCount) = costcap
    dfuelcost(lRecordCount) = fuelcost
    ddrvcost(lRecordCount) = drvcost
    dmaicost(lRecordCount) = maicost
    dtollcost(lRecordCount) = tollcost
            
    If lRecordCount = 1 Then
            dcostcap(1) = costcap
            dfuelcost(1) = fuelcost
            ddrvcost(1) = drvcost
            dmaicost(1) = maicost
            dtollcost(1) = tollcost
    ElseIf lRecordCount > 1 Then
        For i = 1 To lRecordCount - 1
            dcostcap(i) = Format(costcap * Value(i) / sumValue, "0.00")
            dfuelcost(i) = Format(fuelcost * Value(i) / sumValue, "0.00")
            ddrvcost(i) = Format(drvcost * Value(i) / sumValue, "0.00")
            dmaicost(i) = Format(maicost * Value(i) / sumValue, "0.00")
            dtollcost(i) = Format(tollcost * Value(i) / sumValue, "0.00")
            
            dcostcap(lRecordCount) = Format(dcostcap(lRecordCount) - dcostcap(i), "0.00")
            dfuelcost(lRecordCount) = Format(dfuelcost(lRecordCount) - dfuelcost(i), "0.00")
            ddrvcost(lRecordCount) = Format(ddrvcost(lRecordCount) - ddrvcost(i), "0.00")
            dmaicost(lRecordCount) = Format(dmaicost(lRecordCount) - dmaicost(i), "0.00")
            dtollcost(lRecordCount) = Format(dtollcost(lRecordCount) - dtollcost(i), "0.00")
        Next i
    End If
    
    For i = 1 To lRecordCount
        sSQL1 = "update ttosta set costcap=" & dcostcap(i) & ",fuelrmb=" & dfuelcost(i) & ",drvcost=" & ddrvcost(i) & "," & _
               " maicost=" & dmaicost(i) & ",tollrmb=" & dtollcost(i) & " where id=" & lID(i) & ""
        Acs_cnt.BeginTrans
        Acs_cnt.Execute (sSQL1)
        Acs_cnt.CommitTrans
    Next i
    
    
    sSQL2 = "update triphead set deldate=" & lDelDate & ",deltime='" & tDelTime & "',btpdate=" & lBtpDate & ",btptime='" & tBtpTime & "'," & _
            " reftime=" & dreftime & " ,wactime=" & dwactime & ",ishours=" & dishours & ",orepare=" & dorepare & "," & _
            " begkilo=" & dbegkilo & ",endkilo=" & dendkilo & " ,voldeli=" & voldeli & ",volrest=" & volrest & "," & _
            " costcap=" & costcap & ",fuelrmb=" & fuelcost & ",drvcost=" & drvcost & "," & _
            " maicost=" & maicost & ",tollrmb=" & tollcost & ",deliqty=" & SumDeliQty & ",tripdate2=" & lTripDate2 & " where tripsno=" & lTripsNo
    Acs_cnt.BeginTrans
    Acs_cnt.Execute (sSQL2)
    Acs_cnt.CommitTrans
    
    cmdSave.Enabled = False
    cmdmodify.Enabled = True
    Frame3.Enabled = False
    lsvTrips.SetFocus
    Call setTrips(lTripsNo)
    Exit Sub
err:
    MsgBox err.Description, vbOKOnly, "Error"
    
End Sub


Private Sub cmdtrip_Click()
    frmTripstatus.TripType = "CMP"
    frmTripstatus.Show
End Sub

Private Sub Form_Load()
    
    Call iniTrips
    Call iniRecords

    Frame3.Enabled = False
    cmdmodify.Enabled = True
    cmdSave.Enabled = False
'    Call setTrips(lTripsNo)
    
    DTPicker1.Value = Date
    DTPicker3.Value = Date

    DTPicker2.Value = "00:00:00"
    DTPicker4.Value = "00:00:00"
    
End Sub

Private Sub setTrips(ByVal TripsNo As Long)
Dim sSQL As String
Dim ItemX As ListItem
Dim rstTrips As Recordset
Dim iCount As Long

    sSQL = "select distinct c.tripsno,c.truckno,c.driver1,c.drvname1,c.driver2,c.drvname2,c.guarder from ttosta a,orderd b,triphead c " & _
           " where c.tripsno=" & TripsNo & " and a.tripsno=c.tripsno and a.salonum=b.salonum and a.salolin=b.salolin and b.salotyp='CMP' " & _
           " and a.tripsno not in " & _
           " (select distinct a.tripsno from ttosta a,orderd b " & _
           " where a.salonum=b.salonum and a.salolin=b.salolin and b.salotyp='TO')"
    Set rstTrips = Acs_cnt.Execute(sSQL)
    
    lsvTrips.ListItems.Clear
    lsvRecords.ListItems.Clear
    With rstTrips
    Do While Not .EOF
        iCount = iCount + 1