frmiltank.frm

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

VERSION 5.00
Object = "{B02F3647-766B-11CE-AF28-C3A2FBE76A13}#2.5#0"; "SS32X25.OCX"
Object = "{86CF1D34-0C5F-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCT2.OCX"
Begin VB.Form frmiltank 
   Caption         =   "ILTank"
   ClientHeight    =   7140
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   9450
   BeginProperty Font 
      Name            =   "宋体"
      Size            =   10.5
      Charset         =   134
      Weight          =   400
      Underline       =   0   'False
      Italic          =   0   'False
      Strikethrough   =   0   'False
   EndProperty
   LinkTopic       =   "Form1"
   MDIChild        =   -1  'True
   ScaleHeight     =   7140
   ScaleWidth      =   9450
   WindowState     =   2  'Maximized
   Begin VB.TextBox txtCusdesc 
      Height          =   350
      Left            =   1920
      Locked          =   -1  'True
      TabIndex        =   3
      Top             =   6120
      Width           =   2295
   End
   Begin VB.TextBox txtCuscode 
      Height          =   350
      Left            =   1920
      TabIndex        =   0
      Top             =   5460
      Width           =   1455
   End
   Begin PrjLDS.UserControl1 UserControl11 
      Height          =   735
      Left            =   0
      TabIndex        =   2
      Top             =   0
      Width           =   10290
      _ExtentX        =   16880
      _ExtentY        =   1296
   End
   Begin FPSpread.vaSpread vaSpread1 
      Height          =   3495
      Left            =   120
      TabIndex        =   1
      Top             =   840
      Width           =   9135
      _Version        =   131077
      _ExtentX        =   16113
      _ExtentY        =   6165
      _StockProps     =   64
      EditModeReplace =   -1  'True
      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
      MaxCols         =   1
      MaxRows         =   1
      SpreadDesigner  =   "frmiltank.frx":0000
   End
   Begin MSComCtl2.DTPicker DTPicker1 
      Height          =   345
      Left            =   1920
      TabIndex        =   7
      Top             =   4800
      Width           =   1455
      _ExtentX        =   2566
      _ExtentY        =   609
      _Version        =   393216
      Format          =   24641537
      CurrentDate     =   37132
   End
   Begin VB.Label lbldesc 
      Alignment       =   1  'Right Justify
      Caption         =   "Customer Desc:"
      Height          =   255
      Left            =   120
      TabIndex        =   8
      Top             =   6120
      Width           =   1695
   End
   Begin VB.Label lblStatus 
      Caption         =   "Status"
      Height          =   375
      Left            =   6240
      TabIndex        =   6
      Top             =   4680
      Visible         =   0   'False
      Width           =   855
   End
   Begin VB.Label lblCuscode 
      Alignment       =   1  'Right Justify
      Caption         =   "Customer Code:"
      Height          =   375
      Left            =   120
      TabIndex        =   5
      Top             =   5520
      Width           =   1695
   End
   Begin VB.Label lblSysDate 
      Alignment       =   1  'Right Justify
      Caption         =   "System Date:"
      Height          =   255
      Left            =   360
      TabIndex        =   4
      Top             =   4860
      Width           =   1455
   End
End
Attribute VB_Name = "frmiltank"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Private mkey As String

Private lCurSpdRow As Long      '当前SPD的行
Private lCurSpdCol As Long      '当前SPD的列

Private Enum enuDetailCols
'     Cuscode = 1
'     Cusdesc
     inpdate = 1
     tnkcode
     loccode
     procode
     prodesc
     actleve
'     Meaunit
'     conveum
'     convfac
'     physize
    
'     maxleve
'     minleve
'     safleve
'     IsNew                   '如已存在记录为"N",如是第一次则为"Y"
     
     MaxCols = actleve          '总的列数
End Enum





Private Sub txtcuscode_KeyUp(KeyCode As Integer, Shift As Integer)
Dim vVariant As Variant
Dim sSQL As String
Dim rstcus As Recordset
Dim lcuscode As Long, scusdesc As String

    If txtcuscode.Text <> "" And IsNumeric(txtcuscode) Then
        lcuscode = CLng(txtcuscode.Text)
    End If
    If KeyCode = vbKeyReturn Then
        lcuscode = GetCusCode(Trim(txtcuscode.Text))
        If lcuscode > 0 Then
            vaSpread1.MaxRows = 0
            sSQL = "select cuscode,cusdesc from appcus where cuscode=" & lcuscode
            
            Set rstcus = Acs_cnt.Execute(sSQL)
            If Not rstcus.EOF Then
               lcuscode = rstcus!Cuscode
               scusdesc = rstcus!Cusdesc
               txtcuscode.Text = lcuscode
               txtcusdesc.Text = scusdesc
               If mkey = "new" Then
                    Call WriteTnk(lcuscode)
                    Call lockspread(vaSpread1, False)
                    Call LockSpreadCol
                End If
            End If
        End If
    End If
    
End Sub


Private Sub UserControl11_ButtonClick(ByVal Button As MSComctlLib.Button)
    On Error Resume Next
    mkey = LCase(Button.Key)
    
    Select Case LCase(Button.Key)
        Case "new"
             lblstatus.Caption = mkey

            vaSpread1.MaxRows = 0
            
        Case "edit"

        Case "undo"
            If MsgBox("Are you sure to undo?", vbYesNo, vbQuestion) = vbYes Then
                vaSpread1.MaxRows = 0
                txtcuscode.Text = ""
                txtcusdesc.Text = ""
                Call lockspread(vaSpread1, True)
                
            Else
                Exit Sub
            End If
            
        Case "save"
                
                Call SaveILTank
                vaSpread1.MaxRows = 0
                txtcuscode.Text = ""
                txtcusdesc.Text = ""
        
        Case "delete"
'            If MsgBox("Are you want delete this usercode?", vbYesNo, "Message") = vbYes Then
'                Call DeleteClerkInfo
'                Call RefershClerk
'            Else
'                Exit Sub
'            End If
        Case "modify"
            lblstatus.Caption = mkey
'            txtCode.Locked = True
            Call lockspread(vaSpread1, False)
            Call LockSpreadCol
            
        Case "find"
            Call lockspread(vaSpread1, True)
            Call FindRecord
        
        Case "close"
            Unload Me
            Exit Sub
        Case Else
    End Select
    
    Call SetToolBar(mkey)
    
End Sub
Private Sub FindRecord()
Dim sSQL As String
Dim rstFind As Recordset
Dim lHisDate As Long
Dim lcuscode As Long
Dim lrow As Long
    
    If IsNumeric(txtcuscode.Text) Then
        lcuscode = txtcuscode.Text
    Else
        Exit Sub
    End If
    
    lHisDate = ChangeDate(DTPicker1.Value)
    sSQL = "select a.inpdate,a.cuscode,a.tnkcode,a.loccode,a.procode,a.actleve,c.itedesc,b.meaunit,b.conveum,b.convfac,b.physize " & _
           " from iltank a,appcut b,appite c where a.tnkcode=b.tnkcode and a.procode=c.itecode and a.cuscode=b.cuscode and a.procode=b.procode and a.cuscode=" & lcuscode & " and a.inpdate=" & lHisDate & ""
    Set rstFind = Acs_cnt.Execute(sSQL)
    
    lrow = 0
    vaSpread1.MaxRows = 0
    With rstFind
    Do While Not .EOF
        lrow = lrow + 1
        vaSpread1.MaxRows = lrow
        SetValue vaSpread1, lrow, enuDetailCols.inpdate, rstFind!inpdate
        SetValue vaSpread1, lrow, enuDetailCols.tnkcode, rstFind!tnkcode
        SetValue vaSpread1, lrow, enuDetailCols.loccode, rstFind!loccode
        SetValue vaSpread1, lrow, enuDetailCols.procode, rstFind!procode
        SetValue vaSpread1, lrow, enuDetailCols.prodesc, rstFind!Itedesc
        SetValue vaSpread1, lrow, enuDetailCols.actleve, rstFind!actleve
'        SetValue vaSpread1, lrow, enuDetailCols.Meaunit, rstFind!Meaunit
'        SetValue vaSpread1, lrow, enuDetailCols.conveum, rstFind!conveum
'        SetValue vaSpread1, lrow, enuDetailCols.convfac, rstFind!convfac
'        SetValue vaSpread1, lrow, enuDetailCols.physize, rstFind!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

End Sub
Private Sub SaveILTank()
Dim i As Long, iRet As Long
Dim sIsNew As String

If vaSpread1.DataRowCnt = 0 Then Exit Sub

With vaSpread1
If lblstatus.Caption = "new" Then
    For i = 1 To .DataRowCnt
        If GetValue(vaSpread1, i, enuDetailCols.actleve) <> "" Then
            Call AddNewDetail(i)
            Call UpdateDetail(i)
        End If
    Next i
    MsgBox "Save Data is success!", vbOKOnly, "Success"
    
ElseIf lblstatus.Caption = "modify" Then
    If ChangeDate(DTPicker1.Value) < ChangeDate(Date) Then
        If MsgBox("Are you sure to modify this info?", vbYesNo, "Message") = vbYes Then
            For i = 1 To .DataRowCnt
                Call UpdateHisinfo(i)
            Next i
        End If
        MsgBox "Modify Data is success!", vbOKOnly, "Success"
    ElseIf ChangeDate(DTPicker1.Value) = ChangeDate(Date) Then
        For i = 1 To .DataRowCnt
                Call UpdateHisinfo(i)
        Next i
        MsgBox "Save Data is success!", vbOKOnly, "Success"
    ElseIf ChangeDate(DTPicker1.Value) > ChangeDate(Date) Then
        MsgBox "Your Input Date is Wrong!", vbOKOnly, "Wrong"
        Exit Sub
    End If
End If
End With


End Sub

Private Sub UpdateHisinfo(ByVal i As Long)
Dim lTnkCode  As Long, lcuscode As Long, lprocode As Long
Dim lActLeve As Long
Dim sentcode As String
Dim tLastuPD As Long
Dim sSQL As String

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 iltank set actleve=" & lActLeve & ",lastupd=" & tLastuPD & " where cuscode=" & lcuscode & " and procode=" & lprocode & " and tnkcode=" & lTnkCode & ""

Acs_cnt.Execute (sSQL)
End Sub

Private Sub AddNewDetail(ByVal i As Long)
On Error GoTo err
Dim lTnkCode  As Long, lcuscode As Long, lprocode As Long, lConvFac As Long, lPhysize As Long
Dim sLocCode As String, sprodesc As String, sAstatus As String
Dim lActLeve As Long, lMaxLeve As Long, lMinLeve As Long, lSafLeve As Long
Dim sentcode As String, smeaunit As String, sConveUM As String
Dim linpdate As Long
Dim sSQL As String
Dim rstHis As Recordset

lTnkCode = GetValue(vaSpread1, i, enuDetailCols.tnkcode)

lcuscode = txtcuscode.Text
lprocode = GetValue(vaSpread1, i, enuDetailCols.procode)

sLocCode = GetValue(vaSpread1, i, enuDetailCols.loccode)
lActLeve = GetValue(vaSpread1, i, enuDetailCols.actleve)

linpdate = ChangeDate(Date)

sSQL = "select * from iltank where cuscode=" & lcuscode & " and procode=" & lprocode & " and tnkcode=" & lTnkCode & " and inpdate=" & linpdate & ""
Set rstHis = Acs_cnt.Execute(sSQL)
If rstHis.EOF Then
    sSQL = "insert into IlTank(EntCode ,cuscode,tnkcode,loccode,procode,actleve,inpdate,astatus,lastupd)"
    sSQL = sSQL & " values('" & gsEntCode & "'," & lcuscode & "," & lTnkCode & ",'" & sLocCode & "'," & lprocode & ""
    sSQL = sSQL & "," & lActLeve & "," & linpdate & ",'Y'," & linpdate & ") "
    
    Acs_cnt.BeginTrans
    Acs_cnt.Execute (sSQL)
    Acs_cnt.CommitTrans
Else