frmchart.frm

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

    Selection.AutoScaleFont = True
    With Selection.Font
        .name = "宋体"
        .Size = 16
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ColorIndex = xlAutomatic
        .Background = xlAutomatic
    End With
    objwork.ActiveChart.Legend.Select
    
    Selection.Width = 64
    Selection.Height = 202
    Selection.Left = 590
    Selection.Top = 59
    objwork.ActiveChart.PlotArea.Select
    Selection.Width = 532
    Selection.Left = 51
    Selection.Top = 50
    objwork.ActiveChart.SeriesCollection(1).ApplyDataLabels Type:=xlDataLabelsShowValue, _
        AutoText:=True, LegendKey:=False
    
    objwork.ActiveChart.SeriesCollection(1).Select
    With Selection.Border
        .Weight = xlThin
        .LineStyle = xlAutomatic
    End With
    With Selection
        .MarkerBackgroundColorIndex = 1
        .MarkerForegroundColorIndex = 1
        .MarkerStyle = xlSquare
        .Smooth = False
        .MarkerSize = 4
        .Shadow = False
    End With
    
    objwork.ActiveChart.Axes(xlCategory).Select
    Selection.TickLabels.NumberFormatLinked = False
    Selection.TickLabels.NumberFormatLocal = "m-d"
    objwork.ActiveChart.ChartArea.Select
        
    objexcel.Application.Visible = True
    objexcel.Parent.Windows(1).Visible = True
    
    
    
End Sub

Private Sub DataToArray(tmpArray() As Variant)
Dim i, j As Long
Dim tmpData As Variant

    With vasReport
        For i = 1 To .MaxRows
            .Row = i
            For j = 1 To .MaxCols
                .Col = j
                tmpData = .Value
                tmpArray(i, j) = tmpData
            Next j
        Next i
    End With
    
End Sub


Private Sub Combo1_Validate(Cancel As Boolean)
Dim sSQL As String
Dim rsttank As Recordset
    If Combo1.Text = "" Then
    Exit Sub
    End If
    sSQL = "select distinct cuscode,tnkcode from iltank where procode = " & CLng(Combo1.Text)
    Set rsttank = Acs_cnt.Execute(sSQL)
    Combo2.Clear
    Combo3.Clear
    Do While Not rsttank.EOF
    Combo2.AddItem (rsttank!cuscode)
    Combo3.AddItem (rsttank!tnkcode)
    rsttank.MoveNext
    Loop
    Combo2.ListIndex = 0
    Combo3.ListIndex = 0
    rsttank.Close
    Set rsttank = Nothing
      
End Sub


Private Sub Combo2_Validate(Cancel As Boolean)
Dim sSQL As String
Dim rsttank As Recordset
    
    If Combo2.Text = "" Then
        Exit Sub
    End If
    sSQL = "select distinct tnkcode from iltank where cuscode = " & CLng(Combo2.Text) & "and procode = " & CLng(Combo1.Text)
    Set rsttank = Acs_cnt.Execute(sSQL)
    Combo3.Clear
    rsttank.MoveFirst
    Do While Not rsttank.EOF
    Combo3.AddItem (rsttank!tnkcode)
    rsttank.MoveNext
    Loop
    Combo3.ListIndex = 0
    rsttank.Close
    Set rattank = Nothing
    
End Sub

Private Sub Combo3_Validate(Cancel As Boolean)
Dim sSQL As String
Dim rsttank As Recordset
Dim procode, cuscode As String
Dim i As Long
    
    If Combo3.Text = "" Then
        Exit Sub
    End If
    sSQL = "select distinct cuscode,procode from iltank where tnkcode = " & CLng(Combo3.Text)
    Set rsttank = Acs_cnt.Execute(sSQL)
    procode = rsttank!procode
    cuscode = rsttank!cuscode
    For i = 0 To Combo1.ListCount - 1
        Combo1.ListIndex = i
        If Combo1.Text = procode Then
        Exit For
        End If
    Next
    For i = 0 To Combo2.ListCount - 1
        Combo2.ListIndex = i
        If Combo2.Text = cuscode Then
        Exit For
        End If
    Next
    rsttank.Close
    Set rsttank = Nothing
End Sub

Private Sub Command1_Click()
Unload Me
End Sub

Private Sub Form_Activate()
DTPicker1.SetFocus
End Sub

 Private Sub Form_Load()
      'MSChart1.Visible = False
      Call inivas
      Call inicombo
      vasReport.Lock = True
      
      DTPicker1.Value = Now
      DTPicker2.Value = Now
    
      Text1.Enabled = False
      Text2.Enabled = False
      Text3.Enabled = False
      'Cmd_display.Enabled = False
      
 End Sub
 
 Private Sub inicombo()
     Dim sSQL As String
     sSQL = "select distinct procode,cuscode,tnkcode from iltank"
     Set acs_rec = Acs_cnt.Execute(sSQL)
     If acs_rec.EOF Then
        Exit Sub
     Else
        acs_rec.MoveFirst
'        Combo1.AddItem ("")
        Do Until acs_rec.EOF
            Combo1.AddItem acs_rec!procode
            Combo2.AddItem acs_rec!cuscode
            Combo3.AddItem acs_rec!tnkcode
            acs_rec.MoveNext
        Loop
'     Combo1.ListIndex = 0
     End If
     acs_rec.Close
 End Sub

Private Sub inivas()
     With vasReport
            .MaxRows = 0
            .MaxCols = 5 'enuDetailCols.MaxCols
            .ShadowColor = genuBACKCOLOR.CST_Grid_LostFocus
            .Row = -1: .Col = -1
            .BackColor = genuBACKCOLOR.CST_Grid_LostFocus
            .GridColor = vbBlack
            SetColHead vasReport, iltank.Date, "Date", 15
            SetColHead vasReport, iltank.Inventory, "Inventoty", 15
            SetColHead vasReport, 3, "Average level", 10, True
            SetColHead vasReport, 4, "Max level", 10, True
            SetColHead vasReport, 5, "Min level", 10, True
     
     End With
    
End Sub
Private Sub cmd_ok_Click()
     Dim sql As String
     Dim date1 As Long
     Dim date2 As Long
     Dim max, min, ave As Long
     Dim lrow  As Integer
     On Error GoTo err
     If Combo1.Text = "" And Combo3.Text = "" Then
           MsgBox "please choice product or tank !", vbOKOnly
           Exit Sub
     End If
     'Call choicepro
     Call inivas
     
      date1 = CLng(Mid(Format(DTPicker1.Value, "yyyy,mm,dd"), 1, 4) & Mid(Format(DTPicker1.Value, "yyyy-mm-dd"), 6, 2) & Mid(Format(DTPicker1.Value, "yyyy-mm-dd"), 9, 10))
      date2 = CLng(Mid(Format(DTPicker2.Value, "yyyy-mm-dd"), 1, 4) & Mid(Format(DTPicker2.Value, "yyyy-mm-dd"), 6, 2) & Mid(Format(DTPicker2.Value, "yyyy-mm-dd"), 9, 10))
              If DTPicker1.Value = DTPicker2.Value Then
                    sql = "select actleve from iltank where inpdate = " & date1 & "and tnkcode =" & CLng(Combo3.Text)
                    Set acs_rec = Acs_cnt.Execute(sql)
                    lrow = 1
                    If acs_rec.EOF Then
                        MsgBox "No records,please choice again!", vbOKOnly
                        acs_rec.Close
                     Else
                        vasReport.MaxRows = vasReport.MaxRows + 1
                        With vasReport
                         SetValue vasReport, lrow, iltank.Date, Mid(date1, 1, 4) & "-" & Mid(date1, 5, 2) & "-" & Mid(Date, 7, 2)
                         SetValue vasReport, lrow, iltank.Inventory, acs_rec!actleve
                         SetValue vasReport, lrow, 3, acs_rec!actleve
                         SetValue vasReport, lrow, 4, acs_rec!actleve
                         SetValue vasReport, lrow, 5, acs_rec!actleve
                         
                        End With
                        Text1.Text = acs_rec!actleve
                        Text2.Text = acs_rec!actleve
                        Text3.Text = acs_rec!actleve
                       acs_rec.Close
                    End If
              Else
                
                sql = "select (maxleve)as kane from appcut where tnkcode =" & CLng(Combo3.Text)
'                sql = "select max(actleve)as kane from iltank where " & date1 & " < inpdate " & "and inpdate < " & date2 & " and tnkcode =" & CLng(Combo3.Text)
                Set acs_rec = Acs_cnt.Execute(sql)
                max = acs_rec!kane
                acs_rec.Close
                
                sql = "select minleve as kane from appcut where tnkcode = " & CLng(Combo3.Text)
'                sql = "select min(actleve) as kane from iltank where " & date1 & " < inpdate " & "and inpdate < " & date2 & " and tnkcode =" & CLng(Combo3.Text)
                Set acs_rec = Acs_cnt.Execute(sql)
                min = acs_rec!kane
                acs_rec.Close
                sql = "select safleve as kane from appcut where tnkcode = " & CLng(Combo3.Text)
'                sql = "select avg(actleve)  as kane from iltank where " & date1 & " < inpdate " & "and inpdate < " & date2 & " and tnkcode =" & CLng(Combo3.Text)
                Set acs_rec = Acs_cnt.Execute(sql)
                ave = acs_rec!kane
                acs_rec.Close
                Text1.Text = max
                Text2.Text = min
                Text3.Text = ave
                sql = "select actleve,inpdate from iltank where " & date1 & " <=  inpdate " & "and inpdate <= " & date2 & " and tnkcode = " & CLng(Combo3.Text)
                Set acs_rec = Acs_cnt.Execute(sql)
                  If acs_rec.EOF Then
                       MsgBox "No records,please choice again!", vbOKOnly
                       acs_rec.Close
                  Else
                       lrow = 0
                       acs_rec.MoveFirst
                       Do While Not acs_rec.EOF
                       With vasReport
                            lrow = lrow + 1
                            vasReport.MaxRows = vasReport.MaxRows + 1
                            SetValue vasReport, lrow, iltank.Date, Mid(acs_rec!inpdate, 1, 4) & "-" & Mid(acs_rec!inpdate, 5, 2) & "-" & Mid(acs_rec!inpdate, 7, 2)
                            SetValue vasReport, lrow, iltank.Inventory, acs_rec!actleve
                            SetValue vasReport, lrow, 3, Text3.Text
                            SetValue vasReport, lrow, 4, Text1.Text
                            SetValue vasReport, lrow, 5, Text2.Text
                         
                           acs_rec.MoveNext
                       End With
                       Loop
                       acs_rec.Close
                 End If
              End If
          Exit Sub
err:
        MsgBox err.Description, vbOKOnly, "Information"
     
End Sub