⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 frmworkshop1.frm

📁 采用面向负荷控制技术
💻 FRM
字号:
VERSION 5.00
Object = "{65E121D4-0C60-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCHRT20.OCX"
Begin VB.Form frmChart 
   Caption         =   "负荷曲线"
   ClientHeight    =   7005
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   9675
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   7005
   ScaleWidth      =   9675
   WindowState     =   2  'Maximized
   Begin VB.CommandButton cmd_exit 
      Caption         =   "退出"
      Height          =   495
      Left            =   7440
      TabIndex        =   10
      Top             =   6480
      Width           =   1095
   End
   Begin VB.Frame Frame2 
      Height          =   1335
      Left            =   6120
      TabIndex        =   3
      Top             =   240
      Width           =   2655
      Begin VB.OptionButton opt_col 
         Caption         =   "柱状图"
         Height          =   255
         Left            =   240
         TabIndex        =   7
         Top             =   600
         Width           =   1335
      End
      Begin VB.OptionButton opt_curve 
         Caption         =   "曲线图"
         Height          =   255
         Left            =   240
         TabIndex        =   6
         Top             =   240
         Width           =   1575
      End
   End
   Begin VB.Frame Frame1 
      Height          =   1335
      Left            =   0
      TabIndex        =   2
      Top             =   240
      Width           =   5895
      Begin VB.ComboBox cmb_group 
         Height          =   300
         Left            =   3480
         TabIndex        =   8
         Text            =   " "
         Top             =   360
         Width           =   1815
      End
      Begin VB.OptionButton opt_device 
         Caption         =   "设备情况"
         Height          =   255
         Left            =   120
         TabIndex        =   5
         Top             =   720
         Width           =   1215
      End
      Begin VB.OptionButton opt_group 
         Caption         =   "班组情况"
         Height          =   255
         Left            =   120
         TabIndex        =   4
         Top             =   240
         Width           =   1215
      End
      Begin VB.Label Label1 
         AutoSize        =   -1  'True
         Caption         =   "选择班组"
         Height          =   180
         Left            =   2640
         TabIndex        =   9
         Top             =   360
         Width           =   720
      End
   End
   Begin VB.CommandButton cmd_ok 
      Caption         =   "确认"
      Height          =   495
      Left            =   6000
      TabIndex        =   1
      Top             =   6480
      Width           =   1095
   End
   Begin MSChart20Lib.MSChart MSChart1 
      Height          =   4695
      Left            =   0
      OleObjectBlob   =   "frmworkshop1.frx":0000
      TabIndex        =   0
      Top             =   1680
      Width           =   9375
   End
End
Attribute VB_Name = "frmChart"
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"
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

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -