frmcosting.frm

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

    saveinfo = True
    
    Exit Function
    
err:
    MsgBox err.Description, vbOKOnly, "Message"
    
End Function


Private Function ModifyInfo() As Boolean
On Error GoTo err
Dim sSQL1 As String, sSQL2 As String
Dim lID As Long, lsalonum As Long, lsalolin As Long
Dim dkilomet As Double, ddeliqty As Double
    ModifyInfo = False
    
    lID = lsvttosta.SelectedItem.SubItems(5)
    lsalonum = lsvttosta.SelectedItem.SubItems(3)
    lsalolin = lsvttosta.SelectedItem.SubItems(4)
    
    
    dkilomet = ChgDouble(txtkilomet.Text)
    ddeliqty = ChgDouble(txtdeliqty.Text)
    
    sSQL1 = "update ttosta set deliqty=" & ddeliqty & ",kilomet =" & dkilomet & " where id=" & lID
            
    Acs_cnt.BeginTrans
    Acs_cnt.Execute (sSQL1)
    Acs_cnt.CommitTrans
    
    ModifyInfo = True
    
    Exit Function
    
err:
    MsgBox err.Description, vbOKOnly, "Message"
    
End Function

Private Sub Command1_Click()
    
End Sub

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

Private Sub Form_Load()
    
    Call InitToolBar
    Call Initialize
     
    Frame1.Enabled = False
    Frame2.Enabled = True
    
End Sub

Private Function Findttostainfo(Optional ByVal lTripsNo As Long = 0) As Boolean
Dim sSQL As String, lID As Long, smeaunit As String
Dim ItemX As ListItem
Dim rstTtosta As Recordset
Dim iCount As Long
Dim sType As String
    
    Findttostainfo = False
    
'    If txttripsno.Text = "" Or IsNumeric(txttripsno.Text) = False Then
'        Exit Function
'    End If
    
    txtkilomet.Text = "":   txtdeliqty.Text = ""
'    lTripsNo = Trim(txttripsno.Text)
    sSQL = "select a.tripsno,a.id,a.cuscode,a.itecode,a.salonum,a.salolin,a.picknum,b.salotyp,b.meaunit from ttosta a,orderd b where a.cuscode>0 and a.salonum=b.salonum and a.salolin=b.salolin and a.tripsno=" & lTripsNo
    Set rstTtosta = Acs_cnt.Execute(sSQL)
    
    lsvttosta.ListItems.Clear
    
    With rstTtosta
    Do While Not .EOF
        iCount = iCount + 1
        Set ItemX = lsvttosta.ListItems.Add(, "K" & iCount, iCount)
        ItemX.SubItems(1) = "" & .Fields("cuscode")
        ItemX.SubItems(2) = "" & .Fields("itecode")
        ItemX.SubItems(3) = "" & .Fields("salonum")
        ItemX.SubItems(4) = "" & .Fields("salolin")
        ItemX.SubItems(5) = "" & .Fields("ID")
        ItemX.SubItems(6) = "" & .Fields("picknum")
        ItemX.SubItems(7) = "" & .Fields("salotyp")
        ItemX.SubItems(8) = "" & .Fields("meaunit")
        
        .MoveNext
    Loop
    End With
    
    rstTtosta.Close
    Set rstTtosta = Nothing
    
    If lsvttosta.ListItems.Count > 0 Then
        lsvttosta.ListItems(1).Selected = True
        lID = lsvttosta.SelectedItem.SubItems(5)
        sType = lsvttosta.SelectedItem.SubItems(7)
        smeaunit = lsvttosta.SelectedItem.SubItems(8)
        Call RefershRecord(lID, smeaunit)
        Call RefershBar(sType)
    End If
    
    Findttostainfo = True
    
End Function

'Private Sub setttostainfo(Optional ByVal lTripsNo As Long = 0)
'Dim sSQL As String, lID As Long, smeaunit As String
'Dim ItemX As ListItem
'Dim rstTtosta As Recordset
'Dim iCount As Long
'
'    sSQL = "select a.id,a.cuscode,a.itecode,a.salonum,a.salolin,b.salotyp,b.meaunit from ttosta a,orderd b where b.salotyp in('TO') and a.cuscode>0 and a.salonum=b.salonum and a.salolin=b.salolin and a.tripsno=" & lTripsNo & ""
'    Set rstTtosta = Acs_cnt.Execute(sSQL)
'
'    lsvttosta.ListItems.Clear
'
'    With rstTtosta
'    Do While Not .EOF
'        iCount = iCount + 1
'        Set ItemX = lsvttosta.ListItems.Add(, "K" & iCount, iCount)
'        ItemX.SubItems(1) = "" & .Fields("cuscode")
'        ItemX.SubItems(2) = "" & .Fields("itecode")
'        ItemX.SubItems(3) = "" & .Fields("salonum")
'        ItemX.SubItems(4) = "" & .Fields("salolin")
'        ItemX.SubItems(5) = "" & .Fields("ID")
'        ItemX.SubItems(6) = "" & .Fields("picknum")
'        ItemX.SubItems(7) = "" & .Fields("salotyp")
'        ItemX.SubItems(8) = "" & .Fields("meaunit")
'        .MoveNext
'    Loop
'    End With
'
'    rstTtosta.Close
'    Set rstTtosta = Nothing
'
'    If lsvttosta.ListItems.Count > 0 Then
'        lsvttosta.ListItems(1).Selected = True
'        lID = lsvttosta.SelectedItem.SubItems(5)
'        smeaunit = lsvttosta.SelectedItem.SubItems(8)
'        Call RefershRecord(lID, smeaunit)
'    End If
'
'End Sub

Private Sub lsvttosta_ItemClick(ByVal Item As MSComctlLib.ListItem)
Dim lID As String
Dim smeaunit As String
Dim sType As String

    lID = lsvttosta.SelectedItem.SubItems(5)
    sType = lsvttosta.SelectedItem.SubItems(7)
    smeaunit = lsvttosta.SelectedItem.SubItems(8)

    
    Call RefershBar(sType)
    Call RefershRecord(lID, smeaunit)
    
    
End Sub

Private Sub RefershBar(ByVal sType As String)
    
    If sType = "TO" Then
        With UserControl11
            .DisplayButton "New", "New", True, , "New"
            .DisplayButton "Find", "Find", True, , "Find"
            .DisplayButton "Save", "Save", False, , "Save"
            .DisplayButton "Modify", "Modify", False, , "Modify"
            .DisplayButton "Cancel", "Cancel", True, , "Cancel"
            .DisplayButton "Close", "Close", True, , "Close"
        End With
    ElseIf sType = "CMP" Then
        With UserControl11
            .DisplayButton "New", "New", False, , "New"
            .DisplayButton "Find", "Find", True, , "Find"
            .DisplayButton "Save", "Save", False, , "Save"
            .DisplayButton "Modify", "Modify", True, , "Modify"
            .DisplayButton "Cancel", "Cancel", True, , "Cancel"
            .DisplayButton "Close", "Close", True, , "Close"
        End With
    End If
End Sub
Private Sub RefershRecord(ByVal lID As Long, ByVal smeaunit As String)
Dim sSQL As String
Dim rstInfo As Recordset
Dim ItemX As ListItem
Dim ldate As Long
Dim iCount As Long

       
    sSQL = "select * from ttosta where id=" & lID
    Set rstInfo = Acs_cnt.Execute(sSQL)
    
    iCount = 0
    With rstInfo
    Do While Not .EOF
        
        txtdeliqty.Text = SetText(.Fields("deliqty"))
        txtkilomet.Text = SetText(.Fields("kilomet"))
        txttripsno.Text = SetText(.Fields("tripsno"))
        lblunit.Caption = smeaunit
        .MoveNext
    Loop
    End With
    
    rstInfo.Close
    Set rstInfo = Nothing

End Sub

Private Function SetText(ByVal dnumeric As Double) As String

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

End Function

Private Function ChgDouble(ByVal sText As String) As Double

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

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

    sStr = txtdeliqty.Text

    KeyAscii = TxtAscii(sStr, KeyAscii)
End Sub

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

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

    sStr = txtkilomet.Text

    KeyAscii = TxtAscii(sStr, KeyAscii)
End Sub

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

Private Sub txttripsno_KeyDown(KeyCode As Integer, Shift As Integer)
Dim bFind As Boolean
    If KeyCode = vbKeyReturn Then
        bFind = Findttostainfo(txttripsno.Text)
        If bFind = True Then
            Frame1.Enabled = False
            Frame2.Enabled = True
        End If
    End If
End Sub

Private Sub txttripsno_KeyPress(KeyAscii As Integer)

    KeyAscii = NumericAscii(KeyAscii)
    
End Sub

Private Sub UserControl11_ButtonClick(ByVal Button As MSComctlLib.Button)
On Error Resume Next
Dim lTripsNo As Long
Dim bFind As Boolean
    mkey = LCase(Button.Key)
    
    Select Case LCase(Button.Key)
        Case "new"
            If lsvttosta.ListItems.Count = 0 Then
                Exit Sub
            End If
            lblstatus.Caption = mkey
            Frame1.Enabled = True
            Frame2.Enabled = False
        Case "cancel"
            Frame1.Enabled = False
            Frame2.Enabled = True
            txttripsno.Text = ""
            lTripsNo = 0
'            Call setttostainfo(lTripsNo)
            
        Case "edit"

        Case "save"
                If save = False Then
                    Exit Sub
                Else
                    lTripsNo = CLng(txttripsno.Text)
'                    Call setttostainfo(lTripsNo)
                    bFind = Findttostainfo(lTripsNo)
                End If
                
                Frame1.Enabled = False
                Frame2.Enabled = True
        Case "find"
              If Findttostainfo(txttripsno.Text) = False Then
                    Exit Sub
              End If
              
              Frame1.Enabled = False
              Frame2.Enabled = True
        Case "modify"
                If lsvttosta.ListItems.Count = 0 Then
                    Exit Sub
                End If
                lblstatus.Caption = mkey
                
                Frame1.Enabled = True
                Frame2.Enabled = False
                
        Case "close"
            Unload Me
            Exit Sub
        Case Else
    End Select
    
    Call SetToolBar(mkey)
    
End Sub