frmtruhelp.frm

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

VERSION 5.00
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
Begin VB.Form frmtruHelp 
   Caption         =   "Truck Help"
   ClientHeight    =   5835
   ClientLeft      =   2055
   ClientTop       =   1845
   ClientWidth     =   7260
   BeginProperty Font 
      Name            =   "宋体"
      Size            =   9
      Charset         =   134
      Weight          =   400
      Underline       =   0   'False
      Italic          =   0   'False
      Strikethrough   =   0   'False
   EndProperty
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   5835
   ScaleWidth      =   7260
   StartUpPosition =   2  'CenterScreen
   Begin MSComctlLib.ListView lsvTruRecord 
      Height          =   5760
      Left            =   4095
      TabIndex        =   1
      Top             =   15
      Width           =   3135
      _ExtentX        =   5530
      _ExtentY        =   10160
      View            =   3
      LabelWrap       =   -1  'True
      HideSelection   =   -1  'True
      _Version        =   393217
      ForeColor       =   -2147483640
      BackColor       =   -2147483643
      BorderStyle     =   1
      Appearance      =   1
      BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
         Name            =   "宋体"
         Size            =   9.75
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      NumItems        =   0
   End
   Begin MSComctlLib.ListView lsvtruck 
      Height          =   5760
      Left            =   15
      TabIndex        =   0
      Top             =   15
      Width           =   4095
      _ExtentX        =   7223
      _ExtentY        =   10160
      View            =   3
      LabelWrap       =   -1  'True
      HideSelection   =   -1  'True
      _Version        =   393217
      ForeColor       =   -2147483640
      BackColor       =   -2147483643
      BorderStyle     =   1
      Appearance      =   1
      BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
         Name            =   "宋体"
         Size            =   9.75
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      NumItems        =   0
   End
End
Attribute VB_Name = "frmtruHelp"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Public strucode As String
Public strudesc As String
Public lprocode As Long

Private Sub Form_Load()

    Call Inilsvtru
    Call InilsvtruRecord
    
    Call settruckinfo
    
End Sub


Private Sub Inilsvtru()
    
    With lsvtruck
        .FullRowSelect = True
        .MultiSelect = False
        .LabelEdit = lvwManual
        
        .ColumnHeaders.Add , "K1", "Truck No", 1100
        .ColumnHeaders.Add , "K2", "Truck Desc", 1300
        .ColumnHeaders.Add , "K3", "Max Capacity", 1600
        
    End With
    
End Sub

Private Sub InilsvtruRecord()
    
    With lsvTruRecord
        .View = lvwReport
        .FullRowSelect = True
        .MultiSelect = False
        .LabelEdit = lvwManual
        
        .ColumnHeaders.Add , "K1", "No.", 500
        .ColumnHeaders.Add , "K2", "Begin Date", 1300
        .ColumnHeaders.Add , "K3", "End Date", .Width - 1900

    End With
    
End Sub


Private Sub settruckinfo()
Dim sSQL As String, struckno As String
Dim ItemX As ListItem
Dim rstTruck As Recordset
Dim iCount As Long

    sSQL = "select a.truckno,a.trudesc,a.maxtrca,a.actinve,a.itecode,a.altite1,a.altite2,a.altite3 from apptru a where (a.itecode=" & lprocode & " or a.altite1=" & lprocode & "or a.altite2=" & lprocode & " or a.altite3=" & lprocode & ") and a.availab=1"
    Set rstTruck = Acs_cnt.Execute(sSQL)
    
    With rstTruck
    Do While Not .EOF
        iCount = iCount + 1
        Set ItemX = lsvtruck.ListItems.Add(, "K" & iCount, .Fields("truckno"))
        ItemX.SubItems(1) = "" & .Fields("trudesc")
        ItemX.SubItems(2) = "" & .Fields("maxtrca")
'        ItemX.SubItems(3) = "" & .Fields("actinve")
'        ItemX.SubItems(4) = "" & .Fields("itecode")
'        ItemX.SubItems(5) = "" & .Fields("altite1")
'        ItemX.SubItems(6) = "" & .Fields("altite2")
'        ItemX.SubItems(7) = "" & .Fields("altite3")
                
        .MoveNext
    Loop
    End With
    
    rstTruck.Close
    Set rstTruck = Nothing
    
    If lsvtruck.ListItems.Count > 0 Then
        lsvtruck.ListItems(1).Selected = True
        struckno = lsvtruck.SelectedItem.Text
        Call RefershRecord(struckno)
    End If
    
End Sub


Private Sub lsvtruck_DblClick()

If lsvtruck.ListItems.Count > 0 Then
    If lsvtruck.SelectedItem.Index > 0 Then
        strucode = lsvtruck.SelectedItem.Text
        strudesc = lsvtruck.SelectedItem.SubItems(1)
    End If
End If

Unload frmtruHelp


End Sub

Private Sub lsvtruck_ItemClick(ByVal Item As MSComctlLib.ListItem)
Dim struckno As String

    struckno = lsvtruck.SelectedItem.Text
    Call RefershRecord(struckno)
    
End Sub

Private Sub RefershRecord(ByVal struckno As String)
Dim sSQL As String
Dim rstTruRecord As Recordset
Dim ItemX As ListItem
Dim ldate As Long
Dim iCount As Long

    ldate = ChangeDate(Date)
    
    lsvTruRecord.ListItems.Clear
    sSQL = "select * from apptrs where truckno='" & struckno & "' and (enddate>=" & ldate & " or enddate=0)"
    Set rstTruRecord = Acs_cnt.Execute(sSQL)
    
    iCount = 0
    With rstTruRecord
    Do While Not .EOF
        Set ItemX = lsvTruRecord.ListItems.Add(, "K" & iCount, iCount + 1)
        ItemX.SubItems(1) = .Fields("begdate")
        ItemX.SubItems(2) = .Fields("enddate")
        iCount = iCount + 1
        .MoveNext
    Loop
    End With
    
    rstTruRecord.Close
    Set rstTruRecord = Nothing

End Sub

Private Sub lsvtruck_KeyUp(KeyCode As Integer, Shift As Integer)
    If KeyCode = vbKeyReturn Then
        Call lsvtruck_DblClick
    End If
End Sub