frmtru.frm

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

      Begin VB.Label Label5 
         Caption         =   "Description:"
         Height          =   255
         Left            =   3240
         TabIndex        =   22
         Top             =   2880
         Width           =   1095
      End
   End
   Begin FPSpread.vaSpread vastru 
      Height          =   2000
      Left            =   120
      TabIndex        =   1
      Top             =   720
      Width           =   9000
      _Version        =   131077
      _ExtentX        =   15875
      _ExtentY        =   3528
      _StockProps     =   64
      ButtonDrawMode  =   4
      BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
         Name            =   "宋体"
         Size            =   9
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      MaxCols         =   0
      MaxRows         =   0
      RestrictCols    =   -1  'True
      SpreadDesigner  =   "frmTru.frx":0004
      UserResize      =   1
   End
   Begin VB.Label lblstatus 
      Height          =   255
      Left            =   7800
      TabIndex        =   2
      Top             =   2880
      Width           =   975
   End
End
Attribute VB_Name = "frmTru"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Dim mkey As String

Private lCurRow As Long      '当前SPD的行
Private lCurCol As Long      '当前SPD的列

Private Enum trudetail
    Entcode = 1
    truckno
    Itecode
    maxtrca
    actinve
    altite1
    maxalt1
    altite2
    maxalt2
    altite3
    maxalt3
    Astatus
    avadate
    trudesc
    availab
    MaxCols = availab
End Enum

Private Sub cmbalt1_LostFocus()
Dim sSQL As String
Dim rsttru As Recordset
Dim stxt As String
    If cmbalt1.Text <> "" And cmbalt1.Text <> "0" Then
        stxt = getstr(cmbalt1.Text, "/")
    Else
        cmbalt1.Text = "0"
        Exit Sub
    End If
    If IsNumeric(stxt) = True Then
        sSQL = "select * from appite where itecode =" & CLng(stxt) & " and astatus ='Y'"
        Set rsttru = Acs_cnt.Execute(sSQL)
        If Not rsttru.EOF Then
            cmbalt1.Text = stxt
            txtdes1.Text = rsttru!Itedesc
        Else
            MsgBox "The product code is not exist!", vbOKOnly, "Information"
            cmbalt1.SetFocus
        End If
            
        rsttru.Close
        Set rsttru = Nothing
    Else
        MsgBox "The input must be numeric!", vbOKOnly, "Information"
        cmbalt1.SetFocus
    End If
End Sub

Private Sub cmbalt2_LostFocus()
Dim sSQL As String
Dim rsttru As Recordset
Dim stxt As String
    If cmbalt2.Text <> "" And cmbalt2.Text <> "0" Then
        stxt = getstr(cmbalt2.Text, "/")
    Else
        cmbalt2.Text = "0"
        Exit Sub
    End If
    If IsNumeric(stxt) = True Then
        sSQL = "select * from appite where itecode =" & CLng(stxt) & " and astatus = 'Y'"
        Set rsttru = Acs_cnt.Execute(sSQL)
        If Not rsttru.EOF Then
            cmbalt2.Text = stxt
            txtdes2.Text = rsttru!Itedesc
        Else
            MsgBox "The product is not exist!"
            cmbalt2.SetFocus
        End If
        rsttru.Close
        Set rsttru = Nothing
    Else
        MsgBox "The input must be numeric!", vbOKOnly, "Information"
        cmbalt2.SetFocus
    End If
End Sub

Private Sub cmbalt3_LostFocus()
Dim sSQL As String
Dim rsttru As Recordset
Dim stxt As String
    If cmbalt3.Text <> "" And cmbalt3.Text <> "0" Then
        stxt = getstr(cmbalt3.Text, "/")
    Else
        cmbalt3.Text = "0"
        Exit Sub
    End If
    If IsNumeric(stxt) = True Then
        sSQL = "select * from appite where itecode =" & CLng(stxt) & " and astatus = 'Y'"
        Set rsttru = Acs_cnt.Execute(sSQL)
        If Not rsttru.EOF Then
            cmbalt3.Text = stxt
            txtdes3.Text = rsttru!Itedesc
        Else
            MsgBox "The product is not exist!", vbOKOnly, "Information"
            cmbalt3.SetFocus
        End If
        rsttru.Close
        Set rsttru = Nothing
    Else
        MsgBox "The input must be numeric!", vbOKOnly, "Information"
        cmbalt3.SetFocus
    End If
End Sub

Private Sub cmbite_LostFocus()
Dim sSQL As String
Dim rsttru As Recordset
Dim stxt As String
    If cmbite.Text <> "" And cmbite.Text <> "0" Then
        stxt = getstr(cmbite.Text, "/")
    Else
        cmbite.Text = "0"
        Exit Sub
    End If
    If IsNumeric(stxt) = True Then
        sSQL = "select * from appite where itecode =" & CLng(stxt) & " and astatus = 'Y'"
        Set rsttru = Acs_cnt.Execute(sSQL)
        If Not rsttru.EOF Then
            cmbite.Text = stxt
            txtdes.Text = rsttru!Itedesc
        Else
        MsgBox "The product code is not exist", vbOKOnly, "Information"
        cmbite.SetFocus
        End If
        rsttru.Close
        Set rsttru = Nothing
    Else
        MsgBox "The input must be numeric!", vbOKOnly, "Information"
        cmbite.SetFocus
    End If
End Sub

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

Private Sub Combo1_LostFocus()
'Dim stxt As String
'        If Combo1.Text <> "" And Combo1.Text <> "0" Then
'            stxt = getstr(Combo1.Text, "/")
'            Combo1.Text = stxt
'        Else
'            Exit Sub
''            Combo1.SetFocus
'        End If
'
End Sub



Private Sub DTPicker1_KeyDown(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 Form_Load()
    lCurCol = 1
    lCurRow = 1
    Call InitToolBar
    Call initcombobox
    Call initspread
    Call vasshow
    
    Text1.Text = gsEntCode
    Text1.Enabled = False
    Text2.Enabled = False
    lockspread vastru, True
    frminput.Enabled = False
    txtdes.Enabled = False
    txtdes1.Enabled = False
    txtdes2.Enabled = False
    txtdes3.Enabled = False
End Sub

Private Sub initcombobox()
Dim sSQL As String
Dim rsttru As Recordset
    sSQL = "select itecode, itedesc from appite where astatus ='Y' order by itecode "
    Set rsttru = Acs_cnt.Execute(sSQL)
    Do While Not rsttru.EOF
        cmbite.AddItem (rsttru!Itecode & "/" & rsttru!Itedesc)
        cmbalt1.AddItem (rsttru!Itecode & "/" & rsttru!Itedesc)
        cmbalt2.AddItem (rsttru!Itecode & "/" & rsttru!Itedesc)
        cmbalt3.AddItem (rsttru!Itecode & "/" & rsttru!Itedesc)
        rsttru.MoveNext
    Loop
    rsttru.Close
    Set rsttru = Nothing
    sSQL = "select stacode,stadesc from syssta "
    Set rsttru = Acs_cnt.Execute(sSQL)
    Do While Not rsttru.EOF
        Combo1.AddItem (rsttru!stacode & "/" & rsttru!stadesc)
    rsttru.MoveNext
    Loop
    rsttru.Close
    Set rsttru = Nothing
    
End Sub

Private Sub initspread()

    With vastru
            .MaxRows = 0
            .MaxCols = 15 'enuDetailCols.MaxCols
            .ShadowColor = genuBACKCOLOR.CST_Grid_LostFocus
            .Row = -1: .Col = -1
            .BackColor = genuBACKCOLOR.CST_Grid_LostFocus
            .GridColor = vbBlack
     End With
    
     Call IniSpdHeader
     lockspread vastru, True
    
End Sub
Private Sub IniSpdHeader()
vastru.MaxCols = 15
With vastru
SetColHead vastru, trudetail.Entcode, "Entity Code", 15
SetColHead vastru, trudetail.truckno, "Truck No", 10
SetColHead vastru, trudetail.Itecode, "Main Product Code", 10
SetColHead vastru, trudetail.maxtrca, "Max Tran Capacity", 10
SetColHead vastru, trudetail.actinve, "Actual Inventory", 10, True
SetColHead vastru, trudetail.altite1, "Alternative Product1", 15, True
SetColHead vastru, trudetail.maxalt1, "Alternative Product1 Max Capacity", 20, True
SetColHead vastru, trudetail.altite2, "Alternative Product2", 15, True
SetColHead vastru, trudetail.maxalt2, "Alternative Product2 Max Capacity", 20, True
SetColHead vastru, trudetail.altite3, "Alternative Product3", 15, True
SetColHead vastru, trudetail.maxalt3, "Alternative Product3 Max Capacity", 20, True
SetColHead vastru, trudetail.Astatus, "Status", 10, True
SetColHead vastru, trudetail.avadate, "Available Date", 10, True
SetColHead vastru, trudetail.trudesc, "Truck Description", 15, True
SetColHead vastru, 15, "Available", 15, True
End With
'trudetail.availab
End Sub

Private Sub InitToolBar()
    With UserControl1
        .DisplayButton "New", "New", True, , "New"
        .DisplayButton "Save", "Save", False, , "Save"
        .DisplayButton "Cancel", "Cancel", False, , "Cancel"
        '.DisplayButton "Redo", "Redo", False, , "Redo"
        .DisplayButton "Modify", "Modify", True, , "Modify"
        .DisplayButton "Find", "Find", True, , "Find"
        .DisplayButton "Delete", "Delete", True, , "Delete"
        .DisplayButton "Close", "Close", True, , "Close"
    End With
    
    Call EnableDelete(gsRoleCode, UserControl1)
    
End Sub

Private Sub vasshow()
Dim rsttru As Recordset
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, gsEntCode
    SetValue vastru, lrow, trudetail.truckno, rsttru!truckno
    SetValue vastru, lrow, trudetail.Itecode, rsttru!Itecode
    SetValue vastru, lrow, trudetail.maxtrca, rsttru!maxtrca
    SetValue vastru, lrow, trudetail.actinve, rsttru!actinve
    SetValue vastru, lrow, trudetail.altite1, rsttru!altite1
    SetValue vastru, lrow, trudetail.maxalt1, rsttru!maxalt1
    SetValue vastru, lrow, trudetail.altite2, rsttru!altite2
    SetValue vastru, lrow, trudetail.maxalt2, rsttru!maxalt2
    SetValue vastru, lrow, trudetail.altite3, rsttru!altite3
    SetValue vastru, lrow, trudetail.maxalt3, rsttru!maxalt3
    SetValue vastru, lrow, trudetail.Astatus, rsttru!Astatus
    SetValue vastru, lrow, trudetail.avadate, rsttru!avadate
    SetValue vastru, lrow, trudetail.trudesc, rsttru!trudesc
    SetValue vastru, lrow, trudetail.availab, rsttru!availab
        
    
.MoveNext
Loop
End With
rsttru.Close
Set rsttru = Nothing
Call vastru_Click(lCurCol, lCurRow)

End Sub

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

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

Private Sub text2_KeyUp(KeyCode As Integer, Shift As Integer)
Dim Entcode, truckno As String
Dim rsttru As Recordset
Dim sSQL As String
Dim sSQL1 As String
Dim rsttru1 As Recordset
Dim status As String
Dim i As Long

If Text2.Text <> "" And lblstatus.Caption = "search" And KeyCode = vbKeyReturn Then
    Entcode = gsEntCode
    truckno = Text2.Text
    sSQL = "select * from apptru where entcode = '" & Entcode & "'and truckno = '" & truckno & "'"
    Set rsttru = Acs_cnt.Execute(sSQL)
    
    If Not rsttru.EOF Then
        txtentc.Text = gsEntCode
        txttruc.Text = rsttru!truckno
        cmbite.Text = rsttru!Itecode
        txtmaxt.Text = rsttru!maxtrca
        txtacti.Text = rsttru!actinve
        cmbalt1.Text = rsttru!altite1
        txtmaxa1.Text = rsttru!maxalt1
        cmbalt2.Text = rsttru!altite2
        txtmaxa2.Text = rsttru!maxalt2
        cmbalt3.Text = rsttru!altite3
        txtmaxa3.Text = rsttru!maxalt3
        DTPicker1.Value = Mid(rsttru!avadate, 1, 4) & "-" & Mid(rsttru!avadate, 5, 2) & "-" & Mid(rsttru!avadate, 7, 2)
        txttrud.Text = rsttru!trudesc
        
        status = rsttru!Astatus
        sSQL = "select * from syssta where stacode = '" & status & "'"
        Set rsttru = Acs_cnt.Execute(sSQL)
        If Not rsttru.EOF Then
            status = rsttru!stacode & "/" & rsttru!stadesc
        Else
            MsgBox "The truck status is wrong in database!", vbOKOnly, "Error"
            GoTo next1
        End If