frmspect.frm

采用面向负荷控制技术

VERSION 5.00
Object = "{65E121D4-0C60-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCHRT20.OCX"
Begin VB.Form frmSpect 
   Caption         =   "任务监测"
   ClientHeight    =   6780
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   9690
   LinkTopic       =   "Form1"
   MDIChild        =   -1  'True
   ScaleHeight     =   6780
   ScaleWidth      =   9690
   Begin VB.CommandButton cmd_ok 
      Caption         =   "确认"
      Height          =   495
      Left            =   5880
      TabIndex        =   9
      Top             =   6360
      Width           =   1095
   End
   Begin VB.Frame Frame1 
      Height          =   1335
      Left            =   0
      TabIndex        =   4
      Top             =   0
      Visible         =   0   'False
      Width           =   5895
      Begin VB.OptionButton opt_group 
         Caption         =   "班组情况"
         Height          =   255
         Left            =   120
         TabIndex        =   7
         Top             =   240
         Width           =   1215
      End
      Begin VB.OptionButton opt_device 
         Caption         =   "设备情况"
         Height          =   255
         Left            =   120
         TabIndex        =   6
         Top             =   720
         Width           =   1215
      End
      Begin VB.ComboBox cmb_group 
         Height          =   300
         Left            =   3480
         TabIndex        =   5
         Text            =   " "
         Top             =   360
         Width           =   1815
      End
      Begin VB.Label Label1 
         AutoSize        =   -1  'True
         Caption         =   "选择班组"
         Height          =   180
         Left            =   2640
         TabIndex        =   8
         Top             =   360
         Width           =   720
      End
   End
   Begin VB.Frame Frame2 
      Height          =   1335
      Left            =   6120
      TabIndex        =   1
      Top             =   120
      Width           =   2655
      Begin VB.OptionButton opt_curve 
         Caption         =   "曲线图"
         Height          =   255
         Left            =   240
         TabIndex        =   3
         Top             =   240
         Width           =   1575
      End
      Begin VB.OptionButton opt_col 
         Caption         =   "柱状图"
         Height          =   255
         Left            =   240
         TabIndex        =   2
         Top             =   600
         Width           =   1335
      End
   End
   Begin VB.CommandButton cmd_exit 
      Caption         =   "退出"
      Height          =   495
      Left            =   7920
      TabIndex        =   0
      Top             =   6360
      Width           =   1095
   End
   Begin MSChart20Lib.MSChart MSChart1 
      Height          =   4575
      Left            =   120
      OleObjectBlob   =   "frmSpect.frx":0000
      TabIndex        =   10
      Top             =   1440
      Width           =   9975
   End
End
Attribute VB_Name = "frmSpect"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Option Base 1
Dim mconn As New ADODB.Connection
'Dim gname As String

Private Sub cmd_ok_Click()
If opt_curve.Value = True Then
    MSChart1.chartType = VtChChartType2dLine
ElseIf opt_col.Value = True Then
    MSChart1.chartType = VtChChartType2dBar
End If
If opt_device.Value = True Then
    Call fact_showChartDevice(cmb_group.Text)
ElseIf opt_group.Value = True Then
    Call fact_showChartGroup(cmb_group.Text)
End If
End Sub

Private Sub Form_Load()
Dim gname As String, str0
Dim rs As New ADODB.Recordset
mconn.Open "DSN=dlrwdb;uid=sa"
gname = "select distinct location from device"
rs.CursorLocation = adUseClient
rs.Open gname, mconn, adOpenKeyset, adLockPessimistic
rs.MoveFirst
While Not rs.EOF
    cmb_group.AddItem rs(0)
    rs.MoveNext
Wend
rs.Close
gname = getpara()
str0 = Split(gname, ":")
If (str0(1) = "未选班组") Then
    'MsgBox "请选择班组", vbOKOnly
End If
opt_col.Value = True
If str0(0) = "班组" Then
    cmb_group.Text = str0(1)
    opt_group.Value = True
ElseIf str0(0) = "设备" Then
    cmb_group.Text = str0(1)
    opt_device.Value = True
End If
End Sub
Sub fact_showChartGroup(gn As String)
Dim sql As String, rs As New ADODB.Recordset
Dim dd As String, i As Integer, peri As Integer
Dim arr(), dt As Date
If (gn = "未选班组") Then
    MsgBox "请选择班组", vbOKOnly
    Exit Sub
End If

peri = getperiod()
ReDim arr(peri)
dd = Date
arr(1) = gn

For i = 2 To peri
    dt = Date
    dt = dt + i - 2
    dd = dt
    sql = "select sum(timeoccupy) from t_submachineload where plandate='" & dd & "' "
    sql = sql & " and  machinenumber in (select deviceno from "
    sql = sql & " device where location='" & gn & "')"
    rs.CursorLocation = adUseClient
    rs.Open sql, mconn, adOpenKeyset, adLockPessimistic
    rs.MoveFirst
    arr(i) = rs(0)
    rs.Close
Next i
MSChart1.ChartData = arr
End Sub

Sub fact_showChartDevice(gn As String)
Dim sql As String, rs As New ADODB.Recordset, rs1 As New ADODB.Recordset
Dim dd As String, i As Integer, str0, peri As Integer, j As Integer
Dim dt As Date
Dim arr()
If (gn = "未选班组") Then
    MsgBox "请选择班组", vbOKOnly
    Exit Sub
End If

peri = getperiod()
sql = "select * from device where location='" & gn & "'"
rs.CursorLocation = adUseClient
rs.Open sql, mconn, adOpenKeyset, adLockPessimistic
i = rs.RecordCount
If i = 0 Then
    MsgBox "班组不存在", vbOKOnly
    rs.Close
    Exit Sub
End If
ReDim arr(i, peri)
j = 1
rs.MoveFirst
While Not rs.EOF
    dt = Date
    arr(j, 1) = rs("devicename") & rs("deviceno")
    For i = 1 To Period
        dt = Date
        dt = dt + i - 1
        dd = dt
        sql = "select sum(timeoccupy) from t_submachineload where plandate='" & dd & "' "
        sql = sql & " and  machinenumber='" & rs("deviceno") & "'"
        rs1.CursorLocation = adUseClient
        rs1.Open sql, mconn, adOpenKeyset, adLockPessimistic
        rs1.MoveFirst
        If Not IsNull(rs1(0)) Then
            arr(j, i + 1) = rs1(0)
        End If
        rs1.Close
    Next i
    rs.MoveNext
    j = j + 1
Wend
rs.Close
MSChart1.ChartData = arr
End Sub

Private Sub Form_Unload(Cancel As Integer)
Call cmd_exit_Click
End Sub
Sub cmd_exit_Click()
Set mconn = Nothing
Unload Me
End Sub
Function getperiod() As Integer
Dim sql As String, rs1 As New ADODB.Recordset
sql = "select * from t_ctrl"
rs1.CursorLocation = adUseClient
rs1.Open sql, mconn, adOpenKeyset, adLockPessimistic
rs1.MoveFirst
getperiod = rs1("period")
rs1.Close
End Function
Private Sub Comgtt()
Dim findsql As String
Dim findrs As New ADODB.Recordset
If Trim$(cmbmachine1.Text) = "" Then
   MsgBox "请您选择查看的设备类", vbExclamation + vbInformation
   Exit Sub
End If
'findsql = "select  productname,totalamount,max(stateamount) as amount,state   from t_mmmobilestock where drawingnumber='" & Trim$(cmbproductname) & "' group by productname,totalamount,state"
findsql = "select sum(timeoccupy) as occupy,machinenumber from t_submachineload,device where machinenumber=deviceno and devicename='" & cmbmachine1.Text & "' group by machinenumber order by machinenumber"
Set findrs = Nothing
findrs.ActiveConnection = "dsn=dbw;uid=sa"
findrs.CursorLocation = adUseClient
findrs.CursorType = adOpenKeyset
findrs.LockType = adLockOptimistic
findrs.Source = findsql
findrs.Open

Dim sum As Integer
sum = findrs.RecordCount
 If sum = 0 Then
    Exit Sub
 End If
Dim my()
ReDim my(1 To sum, 1 To 3)
findrs.MoveFirst
For i = 1 To sum
 my(i, 1) = "设备号" & findrs("machinenumber")  'labels
 my(i, 2) = findrs("occupy") 'series1 values
' my(i, 3) = findrs("totalamount")
 findrs.MoveNext
Next
  findrs.MoveFirst
 MSChart1.ChartData = my
 MSChart1.TitleText = cmbmachine1.Text & "设备负荷图示"
 MSChart1.Legend.VtFont.Size = 14
 MSChart1.Title.VtFont.Size = 14


   
   
  


End Sub