frmtru.frm

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

                .DisplayButton "Modify", "Modify", True, , "Modify"
                .DisplayButton "Save", "Save", False, , "Save"
                .DisplayButton "Cancel", "Cancel", False, , "Cancel"
                .DisplayButton "Delete", "Delete", True, , "Delete"
                .DisplayButton "Close", "Close", True, , "Close"
            End With
            vastru.Enabled = True
            frminput.Enabled = False
            Text1.Visible = False
            Text2.Visible = False
            lblstatus.Caption = ""
            Call vastru_Click(1, 1)
            
        Case "find"
            With UserControl1
                .DisplayButton "New", "New", False, , "New"
                .DisplayButton "Find", "Find", False, , "Find"
                '.DisplayButton "Print", "Print", True, , "Print"
                .DisplayButton "Save", "Save", False, , "Save"
                .DisplayButton "Modify", "Modify", True, , "Modify"
                .DisplayButton "Cancel", "Cancel", True, , "Cancel"
                .DisplayButton "Delete", "Delete", True, , "Delete"
                .DisplayButton "Close", "Close", True, , "Close"
            End With
            vastru.Enabled = True
            frminput.Enabled = False
            Text1.Enabled = True
            Text2.Enabled = True
            Text2.SetFocus
       Case "save"
            With UserControl1
                .DisplayButton "New", "New", True, , "New"
                .DisplayButton "Find", "Find", True, , "Find"
                '.DisplayButton "Print", "Print", True, , "Print"
                .DisplayButton "Save", "Save", False, , "Save"
                .DisplayButton "Modify", "Modify", True, , "Modify"
                .DisplayButton "Cancel", "Cancel", False, , "Cancel"
                .DisplayButton "Delete", "Delete", True, , "Delete"
                .DisplayButton "Close", "Close", True, , "Close"
            End With
            vastru.Enabled = True
            frminput.Enabled = False
        Case "delete"
            With UserControl1
                .DisplayButton "New", "New", True, , "New"
                .DisplayButton "Find", "Find", True, , "Find"
                '.DisplayButton "Print", "Print", True, , "Print"
                .DisplayButton "Save", "Save", False, , "Save"
                .DisplayButton "Modify", "Modify", True, , "Modify"
                .DisplayButton "Cancel", "Cancel", False, , "Cancel"
                .DisplayButton "Delete", "Delete", True, , "Delete"
                .DisplayButton "Close", "Close", True, , "Close"
            End With
            vastru.Enabled = True
            frminput.Enabled = False
        End Select
    
        Call EnableDelete(gsRoleCode, UserControl1)
End Sub


Private Sub UserControl1_ButtonClick(ByVal Button As MSComctlLib.Button)
    mkey = LCase(Button.Key)
    
    Select Case LCase(Button.Key)
        Case "new"
            lblstatus.Caption = mkey
            Call IniStaDetail
             
        Case "save"
            If lblstatus.Caption = "new" Then
                 If SavetruInfo = False Then
                    Exit Sub
                End If
                Call display
            ElseIf lblstatus.Caption = "modify" Then
                  If trumodify = False Then
                    Exit Sub
                  End If
                Call display
            End If
        Case "delete"
            If MsgBox("Are you want delete this Role?", vbYesNo, "Message") = vbYes Then
            Call delinfo
            Call vasshow
            Else
            Exit Sub
            End If
        Case "find"
            Call IniStaDetail
            lblstatus.Caption = "search"
            frminput.Enabled = False
            Text2.Visible = True
            
        Case "modify"
                
            lblstatus.Caption = mkey
            
        Case "close"
            
            Unload Me
            Exit Sub
       Case Else
    
    End Select
    
    Call SetToolBar(mkey)
    
End Sub


Private Sub IniStaDetail()

txtentc.Text = gsEntCode
txttruc.Text = ""
cmbite.Text = ""
txtmaxt.Text = ""
txtacti.Text = ""
cmbalt1.Text = ""
txtmaxa1.Text = ""
cmbalt2.Text = ""
txtmaxa2.Text = ""
cmbalt3.Text = ""
txtmaxa3.Text = ""
Combo1.ListIndex = 0
DTPicker1.Value = Now
txttrud.Text = ""
txtdes.Text = ""
txtdes1.Text = ""
txtdes2.Text = ""
txtdes3.Text = ""
Check1.Value = 1


End Sub

Private Sub delinfo()
Dim sSQL As String
Dim trucode As String
    trucode = txttruc.Text
    sSQL = "delete from apptru where truckno = '" & trucode & "'"
    Acs_cnt.BeginTrans
    Acs_cnt.Execute (sSQL)
    Acs_cnt.CommitTrans

End Sub

Private Function SavetruInfo() As Boolean
Dim rsttru As Recordset
Dim sSQL As String
Dim trudesc, Astatus As String
Dim avadate As Long
Dim maxalt2 As Long
Dim altite3, maxalt3 As Long
Dim altite2, maxalt1 As Long
Dim altite1, actinve As Long
Dim maxtrca, Itecode As Long
Dim truckno, Entcode As String
Dim flag As Boolean
Dim check As Long

SavetruInfo = False
    
    flag = txttruc.Text <> ""
If flag Then
  If txtmaxa3.Text = "" Then
            txtmaxa3.Text = "0"
            ElseIf IsNumeric(txtmaxa3.Text) = False Then
            MsgBox "The Product3 Max Capacity is wrong input!"
            Exit Function
        End If
           
        If txtmaxa2.Text = "" Then
            txtmaxa2.Text = "0"
            ElseIf IsNumeric(txtmaxa2.Text) = False Then
            MsgBox "The Product2 Max Capacity is wrong input!"
            Exit Function
        End If
              
        If txtmaxa1.Text = "" Then
            txtmaxa1.Text = "0"
            ElseIf IsNumeric(txtmaxa1.Text) = False Then
            MsgBox "The Product1 Max Capacity is wrong input!"
            Exit Function
        End If
           
        If txtacti.Text = "" Then
            txtacti.Text = "0"
            ElseIf IsNumeric(txtacti.Text) = False Then
            MsgBox "The actual inventory is wrong input!"
            Exit Function
        End If
        
        If txtmaxt.Text = "" Then
            txtmaxt.Text = "0"
            ElseIf IsNumeric(txtmaxt.Text) = False Then
            MsgBox "The Product Max Capacity is wrong input!"
            Exit Function
        End If
'
'        If cmbite.Text = "" Then
'            cmbite.Text = "0"
'            ElseIf IsNumeric(cmbite.Text) = False Then
'            MsgBox "The Main product code is wrong input!"
'            Exit Function
'        End If
'
      
        trudesc = txttrud.Text
        avadate = ChangeDate(DTPicker1.Value)
        Astatus = getstr(Combo1.Text, "/")
        maxalt3 = CLng(txtmaxa3.Text)
        altite3 = CLng(getstr(cmbalt3.Text, "/"))
        maxalt2 = CLng(txtmaxa2.Text)
        altite2 = CLng(getstr(cmbalt2.Text, "/"))
        maxalt1 = CLng(txtmaxa1.Text)
        altite1 = CLng(getstr(cmbalt1.Text, "/"))
        actinve = CLng(txtacti.Text)
        maxtrca = CLng(txtmaxt.Text)
        Itecode = CLng(getstr(cmbite.Text, "/"))
        truckno = txttruc.Text
        Entcode = gsEntCode
        check = IIf(Check1.Value, 1, 0)
        
        sSQL = "select * from apptru where entcode='" & Entcode & "'and truckno = '" & truckno & "' "
        Set rsttru = Acs_cnt.Execute(sSQL)
        With rsttru
        If Not .EOF Then
            MsgBox "This Code is exist,please change the Truck code!", vbInformation, "Error"
            Exit Function
        End If
        End With
        rsttru.Close
        Set rsttru = Nothing
        sSQL = "insert into apptru (entcode,truckno,itecode, maxtrca, actinve,altite1,maxalt1,altite2,maxalt2,astatus,avadate,trudesc,altite3,maxalt3,availab)" & _
            "values ('" & gsEntCode & "','" & truckno & "'," & Itecode & "," & maxtrca & "," & actinve & "," & altite1 & "," & maxalt1 & "," & altite2 & "," & maxalt2 & ",'" & Astatus & "'," & avadate & ",'" & trudesc & "'," & altite3 & "," & maxalt3 & "," & check & ")"
        Acs_cnt.BeginTrans
        Acs_cnt.Execute (sSQL)
        Acs_cnt.CommitTrans
        vastru.MaxRows = vastru.MaxRows + 1
         
        SetValue vastru, vastru.MaxRows, 1, Entcode
        SetValue vastru, vastru.MaxRows, 2, truckno
        SetValue vastru, vastru.MaxRows, 3, Itecode
        SetValue vastru, vastru.MaxRows, 4, maxtrca
        SetValue vastru, vastru.MaxRows, 5, actinve
        SetValue vastru, vastru.MaxRows, 6, altite1
        SetValue vastru, vastru.MaxRows, 7, maxalt1
        SetValue vastru, vastru.MaxRows, 8, altite2
        SetValue vastru, vastru.MaxRows, 9, maxalt2
        SetValue vastru, vastru.MaxRows, 10, altite3
        SetValue vastru, vastru.MaxRows, 11, maxalt3
        SetValue vastru, vastru.MaxRows, 12, Astatus
        SetValue vastru, vastru.MaxRows, 13, avadate
        SetValue vastru, vastru.MaxRows, 14, trudesc
        SetValue vastru, vastru.MaxRows, 15, check
    Else
    MsgBox "One or Some items are wrong input!", vbExclamation, "Error"
    SavetruInfo = False
    Exit Function
    End If
    SavetruInfo = True

End Function

Private Function trumodify() As Boolean
Dim sSQL As String
Dim trudesc, Astatus As String
Dim maxalt2 As Long
Dim altite2, maxalt1 As Long
Dim altite3, maxalt3 As Long
Dim altite1, actinve As Long
Dim maxtrca, Itecode As Long
Dim truckno, Entcode As String
Dim avadate As Long
'Dim avadate As Date
Dim lCurRow As Integer
Dim flag As Boolean
Dim check As Long

    trumodify = False
    
    flag = txttruc.Text <> ""
     If flag Then
        If txtmaxa3.Text = "" Then
            txtmaxa3.Text = "0"
            ElseIf IsNumeric(txtmaxa3.Text) = False Then
            MsgBox "The Product3 Max Capacity is wrong input!"
            Exit Function
        End If
           
        If txtmaxa2.Text = "" Then
            txtmaxa2.Text = "0"
            ElseIf IsNumeric(txtmaxa2.Text) = False Then
            MsgBox "The Product2 Max Capacity is wrong input!"
            Exit Function
        End If
              
        If txtmaxa1.Text = "" Then
            txtmaxa1.Text = "0"
            ElseIf IsNumeric(txtmaxa1.Text) = False Then
            MsgBox "The Product1 Max Capacity is wrong input!"
            Exit Function
        End If
           
        If txtacti.Text = "" Then
            txtacti.Text = "0"
            ElseIf IsNumeric(txtacti.Text) = False Then
            MsgBox "The actual inventory is wrong input!"
            Exit Function
        End If
        
        If txtmaxt.Text = "" Then
            txtmaxt.Text = "0"
            ElseIf IsNumeric(txtmaxt.Text) = False Then
            MsgBox "The Product Max Capacity is wrong input!"
            Exit Function
        End If
'
'        If cmbite.Text = "" Then
'            cmbite.Text = "0"
'            ElseIf IsNumeric(cmbite.Text) = False Then
'            MsgBox "The Main product code is wrong input!"
'            Exit Function
'        End If
'
        trudesc = txttrud.Text
        avadate = ChangeDate(DTPicker1.Value)
        Astatus = getstr(Combo1.Text, "/")
        maxalt3 = CLng(txtmaxa3.Text)
        altite3 = CLng(getstr(cmbalt3.Text, "/"))
        maxalt2 = CLng(txtmaxa2.Text)
        altite2 = CLng(getstr(cmbalt2.Text, "/"))
        maxalt1 = CLng(txtmaxa1.Text)
        altite1 = CLng(getstr(cmbalt1.Text, "/"))
        actinve = CLng(txtacti.Text)
        maxtrca = CLng(txtmaxt.Text)
        Itecode = CLng(getstr(cmbite.Text, "/"))
        truckno = txttruc.Text
        Entcode = gsEntCode
        check = IIf(Check1.Value, 1, 0)
       
        sSQL = "update apptru set trudesc= '" & trudesc & "',avadate = " & avadate & ",astatus ='" & Astatus & "',maxalt2 = " & maxalt2 & ",altite2 = " & altite2 & ", maxalt1 = " & maxalt1 & "," & _
                "altite1 = " & altite1 & ",actinve = " & actinve & ",maxtrca = " & maxtrca & ",itecode= " & Itecode & ", altite3 = " & altite3 & ",maxalt3= " & maxalt3 & ",availab=" & check & " where entcode = '" & Entcode & "' and truckno = '" & truckno & "' "
        Acs_cnt.BeginTrans
        Acs_cnt.Execute (sSQL)
        Acs_cnt.CommitTrans
        lCurRow = vastru.ActiveRow
        
        SetValue vastru, lCurRow, 1, Entcode
        SetValue vastru, lCurRow, 2, truckno
        SetValue vastru, lCurRow, 3, Itecode
        SetValue vastru, lCurRow, 4, maxtrca
        SetValue vastru, lCurRow, 5, actinve
        SetValue vastru, lCurRow, 6, altite1
        SetValue vastru, lCurRow, 7, maxalt1
        SetValue vastru, lCurRow, 8, altite2
        SetValue vastru, lCurRow, 9, maxalt2
        SetValue vastru, lCurRow, 10, altite3
        SetValue vastru, lCurRow, 11, maxalt3
        SetValue vastru, lCurRow, 12, Astatus
        SetValue vastru, lCurRow, 13, avadate
        SetValue vastru, lCurRow, 14, trudesc
        SetValue vastru, lCurRow, 15, check
    Else
    MsgBox "One or Some items are wrong input!", vbExclamation, "Error"
    End If
    
    trumodify = True

End Function


Private Sub display()

SetColHead vastru, trudetail.actinve, "Actual Inventory", 10
SetColHead vastru, trudetail.altite1, "Alternative Product1", 10
SetColHead vastru, trudetail.maxalt1, "Alternative Product1 Max Capacity", 20
SetColHead vastru, trudetail.altite2, "Alternative Product2", 15
SetColHead vastru, trudetail.maxalt2, "Alternative Product2 Max Capacity", 20
SetColHead vastru, trudetail.altite3, "Alternative Product3", 15
SetColHead vastru, trudetail.maxalt3, "Alternative Product3 Max Capacity", 20
SetColHead vastru, trudetail.Astatus, "Status", 10
SetColHead vastru, trudetail.avadate, "Available Date", 10
SetColHead vastru, trudetail.trudesc, "Truck Description", 15
SetColHead vastru, trudetail.availab, "Available", 15
End Sub


Private Sub vastru_KeyUp(KeyCode As Integer, Shift As Integer)
Dim lcol, lrow As Long
    lcol = vastru.ActiveCol
    lrow = vastru.ActiveRow
    If KeyCode = vbKeyUp Or KeyCode = vbKeyDown Then
        Call vastru_Click(lcol, lrow)
    End If
End Sub

Private Function getstr(ByVal str1 As String, ByVal str2 As String) As String
Dim i As Integer
    If str1 <> "" Then
        i = InStr(1, str1, str2, vbTextCompare)
        If i >= 2 Then
            getstr = Left(str1, i - 1)
        Else
            getstr = str1
        End If
    Else
        getstr = 0
    End If
End Function