frmiltank.frm

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

    sSQL = "update iltank set actleve=" & lActLeve & "  where cuscode=" & lcuscode & " and procode=" & lprocode & " and tnkcode=" & lTnkCode & " and inpdate=" & linpdate & ""
    Acs_cnt.BeginTrans
    Acs_cnt.Execute (sSQL)
    Acs_cnt.CommitTrans
End If

rstHis.Close
Set rstHis = Nothing

Exit Sub

err:
    MsgBox err.Description, vbOKOnly, "Error"
End Sub

Private Sub UpdateDetail(ByVal i As Long)
Dim lTnkCode  As Long, lcuscode As Long, lprocode As Long
Dim sLocCode As String, sprodesc As String, smeaunit As String, sConvFac As String, sConveUM As String, sAstatus As String
Dim lConvFac As Long, lPhysize As Long
Dim lMaxLeve As Long, lMinLeve As Long, lSafLeve As Long, lActLeve As Long
Dim lOrderSO As Long, lOrderDO As Long, lOrderTO As Long
Dim sentcode As String
Dim tLastuPD As Long
Dim sSQL As String

'lcuscode = GetValue(vaSpread1, i, enuDetailCols.Cuscode)
lcuscode = txtcuscode.Text
lprocode = GetValue(vaSpread1, i, enuDetailCols.procode)
lTnkCode = GetValue(vaSpread1, i, enuDetailCols.tnkcode)
lActLeve = GetValue(vaSpread1, i, enuDetailCols.actleve)

tLastuPD = ChangeDate(Date)

sSQL = "update appcut set actleve=" & lActLeve & ",lastupd=" & tLastuPD & " where cuscode=" & lcuscode & " and procode=" & lprocode & " and tnkcode=" & lTnkCode & ""

Acs_cnt.Execute (sSQL)


End Sub


Private Sub SetToolBar(ByVal mkey As String)
        
        Select Case mkey
        Case "new"
            With UserControl11
                .DisplayButton "New", "New", False, , "New"
'                .DisplayButton "Delete", "Delete", False, , "Delete"
'                .DisplayButton "Print", "Print", True, , "Print"
                .DisplayButton "Modify", "Modify", False, , "Modify"
                .DisplayButton "Find", "Find", False, , "Find"
                .DisplayButton "Save", "Save", True, , "Save"
                .DisplayButton "Cancel", "Cancel", True, , "Cancel"
'                .DisplayButton "Redo", "Redo", True, , "Redo"
                .DisplayButton "Close", "Close", False, , "Close"
            End With
        
        Case "find"
            With UserControl11
                .DisplayButton "New", "New", True, , "New"
                .DisplayButton "Modify", "Modify", True, , "Modify"
                .DisplayButton "Find", "Find", True, , "Find"
                .DisplayButton "Save", "Save", False, , "Save"
                .DisplayButton "Cancel", "Cancel", False, , "Cancel"
                .DisplayButton "Close", "Close", True, , "Close"
            End With
        Case "modify"
            With UserControl11
                .DisplayButton "New", "New", False, , "New"
                .DisplayButton "Find", "Find", False, , "Find"
                .DisplayButton "Modify", "Modify", False, , "Modify"
                .DisplayButton "Save", "Save", True, , "Save"
                .DisplayButton "Cancel", "Cancel", True, , "Cancel"
                .DisplayButton "Close", "Close", False, , "Close"
            End With
            
        Case "cancel"
            With UserControl11
                .DisplayButton "New", "New", True, , "New"
'                .DisplayButton "Delete", "Delete", True, , "Delete"
'                .DisplayButton "Print", "Print", True, , "Print"
                .DisplayButton "Find", "Find", True, , "Find"
                .DisplayButton "Modify", "Modify", False, , "Modify"
                .DisplayButton "Save", "Save", False, , "Save"
                .DisplayButton "Cancel", "Cancel", False, , "Cancel"
'                .DisplayButton "Redo", "Redo", False, , "Redo"
                .DisplayButton "Close", "Close", True, , "Close"
            End With
            
'        Case "delete"
'            With UserControl11
'                .DisplayButton "New", "New", True, , "New"
'                .DisplayButton "Delete", "Delete", True, , "Delete"
'                .DisplayButton "Print", "Print", True, , "Print"
'                .DisplayButton "Find", "Find", True, , "Find"
'                .DisplayButton "Save", "Save", False, , "Save"
'                .DisplayButton "Modify", "Modify", True, , "Modify"
'                .DisplayButton "Undo", "Undo", False, , "Undo"
''                .DisplayButton "Redo", "Redo", False, , "Redo"
'                .DisplayButton "Close", "Close", True, , "Close"
'            End With
            
        Case "save"
            With UserControl11
                .DisplayButton "New", "New", True, , "New"
'                .DisplayButton "Delete", "Delete", True, , "Delete"
'                .DisplayButton "Print", "Print", True, , "Print"
                .DisplayButton "Find", "Find", True, , "Find"
                .DisplayButton "Save", "Save", False, , "Save"
                .DisplayButton "Modify", "Modify", False, , "Modify"
                .DisplayButton "Cancel", "Cancel", False, , "Cancel"
'                .DisplayButton "Redo", "Redo", False, , "Redo"
                .DisplayButton "Close", "Close", True, , "Close"
            End With
            
        Case Else
'            With UserControl11
'                .DisplayButton "New", "New", True, , "New"
'                .DisplayButton "Delete", "Delete", True, , "Delete"
'                .DisplayButton "Print", "Print", True, , "Print"
'                .DisplayButton "Save", "Save", False, , "Save"
'                .DisplayButton "Modify", "Modify", True, , "Modify"
'                .DisplayButton "Undo", "Undo", False, , "Undo"
'                .DisplayButton "Redo", "Redo", False, , "Redo"
'                .DisplayButton "Close", "Close", True, , "Close"
'            End With
            
        End Select

End Sub


Private Sub Form_Load()

    Call InitToolBar
    Call IniSpread
    Call LockSpreadCol
        
    DTPicker1.Value = Format(Date, "YYYY-MM-DD")
End Sub

Private Sub IniSpread()
    
    With vaSpread1
        .MaxRows = 0
        .MaxCols = enuDetailCols.MaxCols
        .ShadowColor = genuBACKCOLOR.CST_Grid_LostFocus
        .Row = -1: .Col = -1
        .BackColor = genuBACKCOLOR.CST_Grid_LostFocus
        .GridColor = vbBlack
    End With
    
    Call IniSpreadHead
    Call lockspread(vaSpread1, True)
    
    vaSpread1.ColsFrozen = 1
End Sub

Private Sub IniSpreadHead()


    SetColHead vaSpread1, enuDetailCols.inpdate, "Input Date", 10
    SetColHead vaSpread1, enuDetailCols.tnkcode, "Tank Code", 12
    SetColHead vaSpread1, enuDetailCols.loccode, "Loc Code", 10, True
    SetColHead vaSpread1, enuDetailCols.procode, "Product Code", 12
    SetColHead vaSpread1, enuDetailCols.prodesc, "Product Desc", 20
'    SetColHead vaSpread1, enuDetailCols.Meaunit, "MeaUnit", 8
    SetColHead vaSpread1, enuDetailCols.actleve, "Actual Level", 14

    
End Sub

Private Sub LockSpreadCol()
    
'    Call LockCell(vaSpread1, enuDetailCols.Cuscode, True)
'    Call LockCell(vaSpread1, enuDetailCols.Cusdesc, True)
    Call LockCell(vaSpread1, enuDetailCols.tnkcode, True)
    Call LockCell(vaSpread1, enuDetailCols.loccode, True)
    Call LockCell(vaSpread1, enuDetailCols.procode, True)
    Call LockCell(vaSpread1, enuDetailCols.prodesc, True)
'    Call LockCell(vaSpread1, enuDetailCols.Meaunit, True)
'    Call LockCell(vaSpread1, enuDetailCols.conveum, True)
'    Call LockCell(vaSpread1, enuDetailCols.convfac, True)
'    Call LockCell(vaSpread1, enuDetailCols.physize, True)
    
End Sub
Private Sub InitToolBar()
    With UserControl11
        .DisplayButton "New", "New", True, , "New"
        .DisplayButton "Save", "Save", False, , "Save"
'        .DisplayButton "Open", "Open", True, , "Open"
        .DisplayButton "Cancel", "Cancel", False, , "Cancel"
'        .DisplayButton "Redo", "Redo", True, , "Redo"
        .DisplayButton "Find", "Find", True, , "Find"
        .DisplayButton "Modify", "Modify", False, , "Modify"
'        .DisplayButton "Delete", "Delete", True, , "Delete"
'        .DisplayButton "Cut", "Cut", True, , "Cut"
'        .DisplayButton "Print", "Print", True, , "Print"
        .DisplayButton "Close", "Close", True, , "Close"
    End With

End Sub

Private Sub vaSpread1_Click(ByVal Col As Long, ByVal Row As Long)

    If vaSpread1.MaxRows > 0 Then
        Call ChangeColor(vaSpread1, vaSpread1.ActiveRow, -1)
    End If
    
End Sub

Private Function CellKeyUpEvent(ByRef spread As vaSpread, _
                                ByVal nKeyCode As Integer, _
                                Optional ByVal nShift As Integer) As Boolean
Dim lID As Long, sname As String, sCode As String
Dim lNextRow As Long, lNextCol As Long
Dim lCurRow As Long, lCurCol As Long, bCancel As Boolean
Dim nloop As Integer
    
    Select Case nKeyCode
        Case vbKeyReturn
            lCurSpdCol = vaSpread1.ActiveCol
            lNextCol = NextVisibleCell(spread, lCurSpdCol)
            If lNextCol <> -1 Then
                lCurCol = lCurSpdCol
                lCurSpdCol = lNextCol
                ActiveCell spread, vaSpread1.ActiveRow, lCurSpdCol
            Else
                If lCurSpdRow < spread.MaxRows Then
                    lCurRow = lCurSpdRow: lCurCol = lCurSpdCol
                    lCurSpdRow = lCurSpdRow + 1: lCurSpdCol = 1
                    ActiveCell spread, lCurSpdRow, lCurSpdCol
                    Call LeaveCellEvent(spread, lCurCol, lCurRow, lCurSpdCol, lCurSpdRow, bCancel)
                End If
            End If
        Case Else
        
    End Select
            
End Function

Private Sub vaSpread1_EditMode(ByVal Col As Long, ByVal Row As Long, ByVal Mode As Integer, ByVal ChangeMade As Boolean)
Dim sCusCode As String
Dim vVariant As Variant

    If Row = vaSpread1.MaxRows Then
        vaSpread1.MaxRows = vaSpread1.MaxRows + 1
    End If
    
    If Mode = 1 Or Row <= 0 Then Exit Sub
    
    With vaSpread1
        Select Case Col
'            Case enuDetailCols.Cuscode
'                 vVariant = GetValue(vaSpread1, Row, enuDetailCols.Cuscode)
'                 If Trim(vVariant) <> "" And IsNumeric(vVariant) Then
'                    Call WriteTnk(vVariant)
'                 End If
'            Case Else
            
        End Select
    End With

End Sub

Private Sub WriteTnk(ByVal sCusCode As String)
Dim rstILTank As Recordset
Dim rstcut As Recordset
Dim sSQL As String
Dim sNew As String
Dim lrow As Long, linpdate As Long

'With vaSpread1
'    SetValue vaSpread1, lrow, enuDetailCols.Cusdesc, ""
'    SetValue vaSpread1, lrow, enuDetailCols.tnkcode, ""
'    SetValue vaSpread1, lrow, enuDetailCols.loccode, ""
'    SetValue vaSpread1, lrow, enuDetailCols.procode, ""
'    SetValue vaSpread1, lrow, enuDetailCols.prodesc, ""
'    SetValue vaSpread1, lrow, enuDetailCols.actleve, ""
'    SetValue vaSpread1, lrow, enuDetailCols.Meaunit, ""
'    SetValue vaSpread1, lrow, enuDetailCols.conveum, ""
'    SetValue vaSpread1, lrow, enuDetailCols.convfac, ""
'    SetValue vaSpread1, lrow, enuDetailCols.physize, ""
'    SetValue vaSpread1, lrow, enuDetailCols.maxleve, ""
'    SetValue vaSpread1, lrow, enuDetailCols.minleve, ""
'    SetValue vaSpread1, lrow, enuDetailCols.safleve, ""
'    SetValue vaSpread1, lrow, enuDetailCols.IsNew, ""
'End With


sSQL = "select b.tnkcode,b.loccode,b.procode,a.itedesc,b.meaunit,b.conveum,b.convfac,b.physize from appite a,appcut b where a.itecode=b.procode and b.cuscode=" & sCusCode
Set rstcut = Acs_cnt.Execute(sSQL)

lrow = 0
With rstcut
Do While Not .EOF
    linpdate = ChangeDate(DTPicker1.Value)
    lrow = lrow + 1
    vaSpread1.MaxRows = lrow
'    SetValue vaSpread1, lRow, enuDetailCols.Cusdesc, rstcut!Cusdesc
    SetValue vaSpread1, lrow, enuDetailCols.inpdate, linpdate
    SetValue vaSpread1, lrow, enuDetailCols.tnkcode, rstcut!tnkcode
    SetValue vaSpread1, lrow, enuDetailCols.loccode, rstcut!loccode
    SetValue vaSpread1, lrow, enuDetailCols.procode, rstcut!procode
    SetValue vaSpread1, lrow, enuDetailCols.prodesc, rstcut!Itedesc
'    SetValue vaSpread1, lrow, enuDetailCols.Meaunit, rstcut!Meaunit
'    SetValue vaSpread1, lrow, enuDetailCols.conveum, rstcut!conveum
'    SetValue vaSpread1, lrow, enuDetailCols.convfac, rstcut!convfac
'    SetValue vaSpread1, lrow, enuDetailCols.physize, rstcut!physize
'    SetValue vaSpread1, lrow, enuDetailCols.maxleve, rstTank!maxleve
'    SetValue vaSpread1, lrow, enuDetailCols.minleve, rstTank!minleve
'    SetValue vaSpread1, lrow, enuDetailCols.safleve, rstTank!safleve
    .MoveNext
Loop
End With


sSQL = "select * from ILTank where cuscode=" & sCusCode
Set rstILTank = Acs_cnt.Execute(sSQL)
If rstILTank.EOF = True Then
    sNew = "Y"
Else
    sNew = "N"
End If

'SetValue vaSpread1, lrow, enuDetailCols.IsNew, sNew

rstcut.Close
rstILTank.Close
Set rstcut = Nothing
Set rstILTank = Nothing

End Sub

Private Sub vaSpread1_GotFocus()
    
    With Me.vaSpread1
        .EditModePermanent = False
    End With
    
    If vaSpread1.MaxRows > 0 Then
        Call ChangeColor(vaSpread1, vaSpread1.ActiveRow, -1)
    End If
    
End Sub

Private Sub vaSpread1_KeyUp(KeyCode As Integer, Shift As Integer)
    
    Call CellKeyUpEvent(vaSpread1, KeyCode, Shift)
    
End Sub

Private Sub vaspread1_LeaveCell(ByVal Col As Long, ByVal Row As Long, ByVal NewCol As Long, ByVal NewRow As Long, Cancel As Boolean)
Dim lCurSpdRow As Long
Dim lCurSpdCol As Long

    lCurSpdRow = Row: lCurSpdCol = Col
    Call LeaveCellEvent(vaSpread1, Col, Row, NewCol, NewRow, Cancel)
    
End Sub

Public Sub LeaveCellEvent(spread As vaSpread, ByVal Col As Long, ByVal Row As Long, ByVal NewCol As Long, ByVal NewRow As Long, Cancel As Boolean)
    If Row = NewRow Then Exit Sub
    If NewRow = -1 And NewCol = -1 Then     '** LostFocus **
        Call ChangeColor(spread, 0, 0, Row, -1, False)
    Else
        Call ChangeColor(spread, NewRow, -1, Row)
    End If
End Sub