frmarrange.frm

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

     amount
     Meaunit
     Id
     
     MaxCols = Id          '总的列数
End Enum

Private Sub InitToolBar()
    With UserControl11
        .DisplayButton "New", "New", True, , "New"
        .DisplayButton "Save", "Save", False, , "Save"
        .DisplayButton "Cancel", "Cancel", False, , "Cancel"
        .DisplayButton "Close", "Close", True, , "Close"
    End With

End Sub

Private Sub cmdinsert_Click()
Dim lprocode As Long, lcuscode As Long
Dim sprodesc As String, scusdesc As String
Dim dquantity As Double, smeaunit As String
Dim lsalonum As Long, lpicknum As Long, lsalolin As Long
Dim lID As Long, TrueMeaUnit As String

If txtprocode.Text = "" Or txtprocode.Text = "0" Then
    MsgBox "Please input the correct data!", vbOKOnly, "Message"
    Exit Sub
End If

If IsNumeric(txtquantity.Text) = False Then
    MsgBox "Please input the correct data!", vbOKOnly, "Message"
    Exit Sub
End If

If DTPicker1.Value > DTPicker2.Value Then
    MsgBox "Begin Date can't Large End date!", vbOKOnly, "Error"
    Exit Sub
End If


dquantity = txtquantity.Text
smeaunit = lblmeaunit.Caption

If vasArrange.DataRowCnt > 0 Then
    TrueMeaUnit = GetValue(vasArrange, 1, enuDetailCols.Meaunit)
    If TrueMeaUnit <> smeaunit Then
        MsgBox "Unit of Measurement is wrong!", vbOKOnly, "Error"
        Exit Sub
    End If
End If

lprocode = txtprocode.Text
sprodesc = txtprodesc.Text
lcuscode = txtcuscode.Text
scusdesc = txtcusdesc.Text
lsalonum = txtordnum.Text
lpicknum = txtpicknum.Text
lsalolin = txtsalolin.Text

If saveinfo = False Then
    MsgBox "Insert Data is Fail!", vbOKOnly, "Message"
    Exit Sub
End If

lID = GetTicketId

If lID = 0 Then
    MsgBox "This Operator has some error", vbOKOnly, "Error"
    Exit Sub
End If

vasArrange.MaxRows = vasArrange.MaxRows + 1

With vasArrange
    .Row = .MaxRows

    SetValue vasArrange, .Row, enuDetailCols.ordnum, lsalonum
    SetValue vasArrange, .Row, enuDetailCols.picknum, lpicknum
    SetValue vasArrange, .Row, enuDetailCols.salolin, lsalolin
    SetValue vasArrange, .Row, enuDetailCols.cuscode, lcuscode
    SetValue vasArrange, .Row, enuDetailCols.Cusdesc, scusdesc
    SetValue vasArrange, .Row, enuDetailCols.procode, lprocode
    SetValue vasArrange, .Row, enuDetailCols.prodesc, sprodesc
    SetValue vasArrange, .Row, enuDetailCols.amount, dquantity
    SetValue vasArrange, .Row, enuDetailCols.Meaunit, smeaunit
    SetValue vasArrange, .Row, enuDetailCols.Id, lID
End With



Call iniTxt

End Sub

Private Function GetTicketId() As Long
Dim sSQL As String
Dim rstTemp As Recordset

GetTicketId = 0
sSQL = "select max(Id) as maxid from ttosta"
Set rstTemp = Acs_cnt.Execute(sSQL)

With rstTemp
Do While Not .EOF
    GetTicketId = rstTemp!maxid
    .MoveNext
Loop
End With

rstTemp.Close
Set rstTemp = Nothing

End Function

Private Sub iniTxt()
'    txtprocode.Text = ""
'    txtprodesc.Text = ""
    txtcuscode.Text = ""
    txtcusdesc.Text = ""
    txtordnum.Text = ""
    txtpicknum.Text = ""
    txtsalolin.Text = ""
    
    txtquantity.Text = ""
    lblmeaunit.Caption = ""

End Sub


Private Sub iniTxt2()

    txttruck.Text = ""
    txttrudesc.Text = ""
    txtdriver1.Text = ""
    txtdriver2.Text = ""
    txtdrvdesc1.Text = ""
    txtdrvdesc2.Text = ""
    txtguarder.Text = ""
    
    txtprocode.Text = ""
    txtprodesc.Text = ""
    txtcuscode.Text = ""
    txtcusdesc.Text = ""
    txtordnum.Text = ""
    txtpicknum.Text = ""
    txtsalolin.Text = ""
    
    txtquantity.Text = ""
    lblmeaunit.Caption = ""

End Sub

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

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

Private Sub Form_Load()

    Me.Icon = LoadPicture()
    Call InitToolBar
    Call IniSpdHeader

    Call lockspread(vasArrange, True)

    frmHead.Enabled = False
    frmInfo.Enabled = False
    
    DTPicker1.Value = Date
    DTPicker2.Value = Date

End Sub


Private Sub IniSpdHeader()

   vasArrange.MaxRows = 0
   vasArrange.MaxCols = enuDetailCols.MaxCols

   SetColHead vasArrange, enuDetailCols.ordnum, "Order Number", 10
   SetColHead vasArrange, enuDetailCols.picknum, "Pick Number", 10
   SetColHead vasArrange, enuDetailCols.cuscode, "Customer Code", 12
   SetColHead vasArrange, enuDetailCols.Cusdesc, "Customer Desc", 12
   SetColHead vasArrange, enuDetailCols.salolin, "Line Number", 12
   SetColHead vasArrange, enuDetailCols.procode, "Product Code", 12
   SetColHead vasArrange, enuDetailCols.prodesc, "Product Desc", 12
   SetColHead vasArrange, enuDetailCols.Meaunit, "MeaUnit", 14
   SetColHead vasArrange, enuDetailCols.amount, "Quantity", 12
   SetColHead vasArrange, enuDetailCols.Id, "ID", 12, True

End Sub


Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
    If vasArrange.MaxRows > 0 Then
        MsgBox "Please Save your Date!", vbOKOnly, "Message"
        Cancel = True
        Exit Sub
    Else
        
    End If
End Sub

Private Sub txtcuscode_DblClick()
Dim lprocode As Long

        If txtprocode.Text <> "" Then
            lprocode = txtprocode.Text
        Else
            Exit Sub
        End If
        frmDownOrderList.lprocode = lprocode
        frmDownOrderList.Show vbModal
        
        txtprocode.Text = frmDownOrderList.lprocode
        txtprocode.Tag = frmDownOrderList.lprocode
        txtprodesc.Text = frmDownOrderList.sprodesc
        txtcuscode.Text = frmDownOrderList.lcuscode
        txtcusdesc.Text = frmDownOrderList.scusdesc
        txtordnum.Text = frmDownOrderList.lsalonum
        txtpicknum.Text = frmDownOrderList.lpicknum
        txtsalolin.Text = frmDownOrderList.lsalolin
        txtquantity.Text = frmDownOrderList.dquantity
        lblmeaunit.Caption = frmDownOrderList.smeaunit

End Sub

Private Sub txtcuscode_KeyUp(KeyCode As Integer, Shift As Integer)
Dim lprocode As Long
    If KeyCode = vbKeyF1 Then
'        If vasArrange.DataRowCnt > 0 Then
'            lprocode = GetValue(vasArrange, 1, enuDetailCols.procode)
'        End If
'        Load frmHelp
        If txtprocode.Text <> "" Then
            lprocode = txtprocode.Text
        Else
            Exit Sub
        End If
        frmDownOrderList.lprocode = lprocode
        frmDownOrderList.Show vbModal
        
        txtprocode.Text = frmDownOrderList.lprocode
        txtprocode.Tag = frmDownOrderList.lprocode
        txtprodesc.Text = frmDownOrderList.sprodesc
        txtcuscode.Text = frmDownOrderList.lcuscode
        txtcusdesc.Text = frmDownOrderList.scusdesc
        txtordnum.Text = frmDownOrderList.lsalonum
        txtpicknum.Text = frmDownOrderList.lpicknum
        txtsalolin.Text = frmDownOrderList.lsalolin
        txtquantity.Text = frmDownOrderList.dquantity
        lblmeaunit.Caption = frmDownOrderList.smeaunit
    ElseIf KeyCode = vbKeyReturn Then
        SendKeys "{tab}"
    End If

End Sub

Private Sub txtdriver1_DblClick()
Dim sdrvcode As String
Dim sDrvName As String

        With frmdrvhelp
            .Show vbModal
            sdrvcode = frmdrvhelp.sdrvcode
            sDrvName = frmdrvhelp.sDrvName

        End With
        
        txtdriver1.Text = sdrvcode
        txtdriver1.Tag = sdrvcode
        txtdrvdesc1.Text = sDrvName
End Sub

Private Sub txtdriver1_KeyUp(KeyCode As Integer, Shift As Integer)
Dim sdrvcode As String
Dim sDrvName As String

    If KeyCode = vbKeyF1 Then
        With frmdrvhelp
            .Show vbModal
            sdrvcode = frmdrvhelp.sdrvcode
            sDrvName = frmdrvhelp.sDrvName

        End With
        
        txtdriver1.Text = sdrvcode
        txtdriver1.Tag = sdrvcode
        txtdrvdesc1.Text = sDrvName
    ElseIf KeyCode = vbKeyReturn Then
        SendKeys "{tab}"
    End If

End Sub

Private Sub txtdriver1_LostFocus()
    If txtdriver1.Text <> txtdriver1.Tag Then
        txtdriver1.Text = ""
        txtdriver1.Tag = ""
        txtdrvdesc1.Text = ""
    End If
End Sub

Private Sub txtdriver2_DblClick()
Dim sdrvcode As String
Dim sDrvName As String

        With frmdrvhelp
            .Show vbModal
            sdrvcode = frmdrvhelp.sdrvcode
            sDrvName = frmdrvhelp.sDrvName
        End With
        
        txtdriver2.Text = sdrvcode
        txtdriver2.Tag = sdrvcode
        txtdrvdesc2.Text = sDrvName
    
End Sub

Private Sub txtdriver2_KeyUp(KeyCode As Integer, Shift As Integer)
Dim sdrvcode As String
Dim sDrvName As String

    If KeyCode = vbKeyF1 Then
        With frmdrvhelp
            .Show vbModal
            sdrvcode = frmdrvhelp.sdrvcode
            sDrvName = frmdrvhelp.sDrvName
        End With
        
        txtdriver2.Text = sdrvcode
        txtdriver2.Tag = sdrvcode
        txtdrvdesc2.Text = sDrvName
    ElseIf KeyCode = vbKeyReturn Then
        SendKeys "{tab}"
    End If


End Sub


Private Sub txtdriver2_LostFocus()
    If txtdriver2.Text <> txtdriver2.Tag Then
        txtdriver2.Text = ""
        txtdriver2.Tag = ""
        txtdrvdesc2.Text = ""
    End If
End Sub

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

Private Sub txtprocode_DblClick()
Dim lprocode As Long
   
    If vasArrange.DataRowCnt > 0 Then
        lprocode = GetValue(vasArrange, 1, enuDetailCols.procode)
    End If
    frmHelp.lprocode = lprocode
    Load frmHelp
          
    frmHelp.Show vbModal
    
    txtprocode.Text = frmHelp.lprocode
    txtprocode.Tag = frmHelp.lprocode
    txtprodesc.Text = frmHelp.sprodesc