?? frmqueuestate.frm
字號:
VERSION 5.00
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
Object = "{65E121D4-0C60-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCHRT20.OCX"
Begin VB.Form frmQueueState
Caption = "當前排隊狀態"
ClientHeight = 6015
ClientLeft = 60
ClientTop = 345
ClientWidth = 8415
Icon = "frmQueueState.frx":0000
LinkTopic = "Form1"
LockControls = -1 'True
MDIChild = -1 'True
ScaleHeight = 6015
ScaleWidth = 8415
WindowState = 2 'Maximized
Begin MSComctlLib.ImageList img1
Left = 3120
Top = 5400
_ExtentX = 1005
_ExtentY = 1005
BackColor = -2147483643
ImageWidth = 16
ImageHeight = 16
MaskColor = 12632256
_Version = 393216
BeginProperty Images {2C247F25-8591-11D1-B16A-00C0F0283628}
NumListImages = 2
BeginProperty ListImage1 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmQueueState.frx":0CCA
Key = ""
EndProperty
BeginProperty ListImage2 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmQueueState.frx":1064
Key = ""
EndProperty
EndProperty
End
Begin VB.Frame fra3
Caption = "排隊隊列"
BeginProperty Font
Name = "宋體"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 5775
Left = 120
TabIndex = 5
Top = 120
Width = 2535
Begin MSComctlLib.TreeView trvQueue
Height = 5415
Left = 120
TabIndex = 6
Top = 240
Width = 2295
_ExtentX = 4048
_ExtentY = 9551
_Version = 393217
Indentation = 529
LabelEdit = 1
Style = 7
FullRowSelect = -1 'True
ImageList = "img1"
Appearance = 1
End
End
Begin VB.Frame fraWait
Caption = "最長初始等待時間(分)"
BeginProperty Font
Name = "宋體"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 2415
Left = 2760
TabIndex = 3
Top = 2880
Width = 5535
Begin MSChart20Lib.MSChart mscWait
Height = 2055
Left = 120
OleObjectBlob = "frmQueueState.frx":13FE
TabIndex = 4
TabStop = 0 'False
Top = 240
Width = 5295
End
End
Begin VB.Frame fraNumber
Caption = "當前服務排隊人數(個)"
BeginProperty Font
Name = "宋體"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 2415
Left = 2760
TabIndex = 1
Top = 120
Width = 5535
Begin MSChart20Lib.MSChart mscNumber
Height = 2055
Left = 120
OleObjectBlob = "frmQueueState.frx":31FF
TabIndex = 2
TabStop = 0 'False
Top = 240
Width = 5295
End
End
Begin VB.CommandButton cmdQuit
Caption = "關閉(&C)"
Height = 375
Left = 7200
TabIndex = 0
Top = 5520
Width = 1095
End
Begin VB.CommandButton cmdRefresh
Caption = "刷新(&R)"
Height = 375
Left = 6120
TabIndex = 7
Top = 5520
Width = 1095
End
End
Attribute VB_Name = "frmQueueState"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim m_tagErrInfo As TYPE_ERRORINFO
Dim m_bChoice As Boolean '是否選擇了 TreeView 的選項
Dim m_sChoice As String '選擇的 TreeView 的選項的 Key
Private Sub cmdQuit_Click()
On Error Resume Next
Unload Me
End Sub
Private Sub cmdRefresh_Click()
On Error Resume Next
Dim i As Integer
'清除圖表信息
mscNumber.Column = 1
For i = 1 To mscNumber.RowCount
mscNumber.Row = i
mscNumber.Data = 0
Next i
mscWait.Column = 1
For i = 1 To mscWait.RowCount
mscWait.Row = i
mscWait.Data = 0
Next i
m_bChoice = False
m_sChoice = ""
InitTreeView
End Sub
Private Sub Form_Activate()
On Error Resume Next
m_bStatus = True
End Sub
Private Sub Form_Load()
On Error GoTo ERROR_EXIT
Dim i As Integer
'清除圖表信息
mscNumber.Column = 1
For i = 1 To mscNumber.RowCount
mscNumber.Row = i
mscNumber.Data = 0
Next i
mscWait.Column = 1
For i = 1 To mscWait.RowCount
mscWait.Row = i
mscWait.Data = 0
Next i
m_bChoice = False
m_sChoice = ""
If InitTreeView = False Then GoTo ERROR_EXIT
Exit Sub
ERROR_EXIT:
m_tagErrInfo.strErrDate = Format(Now, "yyyy-mm-dd hh:mm:ss")
m_tagErrInfo.strErrFile = "frmQueueState"
m_tagErrInfo.strErrFunc = "Form_Load"
m_tagErrInfo.nErrNum = Err.Number
m_tagErrInfo.strErrDesc = Error(Err.Number)
If Err.Number <> 0 Then Err.Clear
modErrorInfo.WriteErrLog m_tagErrInfo
End Sub
Private Sub Form_Resize()
On Error Resume Next
Dim i As Integer, j As Integer
If Me.WindowState = 1 Then Exit Sub
If Me.Width < 8535 Then Me.Width = 8535
If Me.Height < 6420 Then Me.Height = 6420
i = Me.Width - 8535
j = Me.Height - 6420
'修改寬度
fra3.Width = i + 2535
trvQueue.Width = i + 2295
fraNumber.Left = i + 2760
fraWait.Left = i + 2760
cmdRefresh.Left = i + 6120
cmdQuit.Left = i + 7200
'修改高度位置
fra3.Height = j + 5775
trvQueue.Height = j + 5415
fraNumber.Height = j / 2 + 2415
mscNumber.Height = j / 2 + 2055
fraWait.Height = j / 2 + 2415
mscWait.Height = j / 2 + 2055
fraWait.Top = j / 2 + 2880
cmdRefresh.Top = j + 5520
cmdQuit.Top = j + 5520
End Sub
Private Sub Form_Terminate()
On Error Resume Next
Set frmSeatSet = Nothing
End Sub
Private Sub Form_Unload(Cancel As Integer)
On Error Resume Next
m_bStatus = False
End Sub
Private Sub trvQueue_NodeClick(ByVal Node As MSComctlLib.Node)
On Error GoTo ERROR_EXIT
If Node.Root.Text = Node.Text Then
m_bChoice = True
m_sChoice = Mid$(Node.Key, 1, InStr(Node.Key, vbTab) - 1)
Else
m_bChoice = False
m_sChoice = ""
End If
InitChart
Exit Sub
ERROR_EXIT:
m_tagErrInfo.strErrDate = Format(Now, "yyyy-mm-dd hh:mm:ss")
m_tagErrInfo.strErrFile = "frmQueueState"
m_tagErrInfo.strErrFunc = "trvQueue_NodeClick"
m_tagErrInfo.nErrNum = Err.Number
m_tagErrInfo.strErrDesc = Error(Err.Number)
If Err.Number <> 0 Then Err.Clear
modErrorInfo.WriteErrLog m_tagErrInfo
End Sub
'////////////////////////////////////////////////////////////////////////////////////////////////////
'/初始化系統中 TreeView
Public Function InitTreeView() As Boolean
On Error GoTo ERROR_EXIT
Dim rs As New ADODB.Recordset, cmd As New ADODB.Command
Dim strSQL As String, i As Integer
Dim ndObject As Node
trvQueue.Nodes.Clear
'連接數據庫
cmd.ActiveConnection = dbMyDB
cmd.CommandType = adCmdText
'查詢數據庫
strSQL = "SELECT * FROM Style WHERE st_type = 1 AND nouse_yesno = 0"
cmd.CommandText = strSQL
rs.CursorLocation = adUseClient
rs.Open cmd, , adOpenStatic, adLockReadOnly
If Not rs.EOF And rs.RecordCount > 0 Then
rs.MoveFirst
For i = 1 To rs.RecordCount
Set ndObject = trvQueue.Nodes.Add(, , rs!st_code & vbTab & rs!st_name, rs!st_name)
ndObject.Image = 2
rs.MoveNext
Next i
Else
InitTreeView = False
Exit Function
End If
rs.Close
'加入排隊隊列; 客戶編號,到達時間,轉隊列服務
If rs.State = adStateOpen Then rs.Close
strSQL = "SELECT * FROM VIEW_Queue_Customer_Change WHERE service_date = '" & Date & "'"
cmd.CommandText = strSQL
rs.CursorLocation = adUseClient
rs.Open cmd, , adOpenStatic, adLockReadOnly
If Not rs.EOF And rs.RecordCount > 0 Then
rs.MoveFirst
For i = 1 To rs.RecordCount
Set ndObject = trvQueue.Nodes.Add(rs!service_code & vbTab & rs!service_name, _
tvwChild, rs!customer_id & vbTab & rs!service_date, _
rs!customer_id & " " & rs!start_time & " " & "轉換隊列")
ndObject.Image = 1
rs.MoveNext
Next i
End If
rs.Close
If rs.State = adStateOpen Then rs.Close
strSQL = "SELECT * FROM VIEW_QUEUE_Customer_Start WHERE service_date = '" & Date & "'"
cmd.CommandText = strSQL
rs.CursorLocation = adUseClient
rs.Open cmd, , adOpenStatic, adLockReadOnly
If Not rs.EOF And rs.RecordCount > 0 Then
rs.MoveFirst
For i = 1 To rs.RecordCount
Set ndObject = trvQueue.Nodes.Add(rs!service_code & vbTab & rs!service_name, _
tvwChild, rs!customer_id & vbTab & rs!service_date, _
rs!customer_id & " " & rs!start_time & " " & "初始隊列")
ndObject.Image = 1
rs.MoveNext
Next i
End If
rs.Close
For i = 1 To trvQueue.Nodes.Count
trvQueue.Nodes(i).Expanded = True
Next i
If rs.State = adStateOpen Then rs.Close
Set rs = Nothing
Set cmd = Nothing
InitTreeView = True
Exit Function
ERROR_EXIT:
m_tagErrInfo.strErrDate = Format(Now, "yyyy-mm-dd hh:mm:ss")
m_tagErrInfo.strErrFile = "frmQueueState"
m_tagErrInfo.strErrFunc = "InitTreeView"
m_tagErrInfo.nErrNum = Err.Number
m_tagErrInfo.strErrDesc = Error(Err.Number)
If Err.Number <> 0 Then Err.Clear
modErrorInfo.WriteErrLog m_tagErrInfo
InitTreeView = False
End Function
'初始化 Chart 控件
Public Function InitChart() As Boolean
On Error GoTo ERROR_EXIT
Dim rs As New ADODB.Recordset, cmd As New ADODB.Command
Dim strSQL As String, iResult As Integer, i As Integer
Dim sTime As String
If m_bChoice = False Or m_sChoice = "" Then
'清除圖表信息
mscNumber.Column = 1
For i = 1 To mscNumber.RowCount
mscNumber.Row = i
mscNumber.Data = 0
Next i
mscWait.Column = 1
For i = 1 To mscWait.RowCount
mscWait.Row = i
mscWait.Data = 0
Next i
InitChart = False
Exit Function
End If
'刷新當前排隊人數圖
mscNumber.Column = 1
For i = 1 To mscNumber.RowCount - 1
mscNumber.Row = i + 1
iResult = mscNumber.Data
mscNumber.Row = i
mscNumber.Data = iResult
Next i
'刷新當前平均排隊時間
mscWait.Column = 1
For i = 1 To mscWait.RowCount - 1
mscWait.Row = i + 1
iResult = mscWait.Data
mscWait.Row = i
mscWait.Data = iResult
Next i
iResult = 0
'連接數據庫
cmd.ActiveConnection = dbMyDB
cmd.CommandType = adCmdText
'求計算機編號
strSQL = "SELECT * FROM VIEW_Queue_Customer_Change WHERE service_date = '" & Date & _
"' AND service_code = '" & m_sChoice & "'"
cmd.CommandText = strSQL
rs.CursorLocation = adUseClient
rs.Open cmd, , adOpenStatic, adLockReadOnly
If Not rs.EOF And rs.RecordCount > 0 Then
iResult = rs.RecordCount
End If
rs.Close
sTime = Date & " " & Time
If rs.State = adStateOpen Then rs.Close
strSQL = "SELECT * FROM VIEW_QUEUE_Customer_Start WHERE service_date = '" & Date & _
"' AND service_code = '" & m_sChoice & "'"
cmd.CommandText = strSQL
rs.CursorLocation = adUseClient
rs.Open cmd, , adOpenStatic, adLockReadOnly
If Not rs.EOF And rs.RecordCount > 0 Then
iResult = iResult + rs.RecordCount
For i = 1 To rs.RecordCount
If TimeValue(sTime) > TimeValue(rs!start_time) Then
sTime = rs!start_time
End If
rs.MoveNext
Next i
End If
rs.Close
'更新當前排隊人數圖
mscNumber.Column = 1
mscNumber.Row = mscNumber.RowCount
mscNumber.Data = iResult
'更新最大等待時間
iResult = DateDiff("n", sTime, Date & " " & Time)
mscWait.Column = 1
mscWait.Row = mscWait.RowCount
mscWait.Data = iResult
InitChart = True
Exit Function
ERROR_EXIT:
m_tagErrInfo.strErrDate = Format(Now, "yyyy-mm-dd hh:mm:ss")
m_tagErrInfo.strErrFile = "frmQueueState"
m_tagErrInfo.strErrFunc = "InitChart"
m_tagErrInfo.nErrNum = Err.Number
m_tagErrInfo.strErrDesc = Error(Err.Number)
If Err.Number <> 0 Then Err.Clear
modErrorInfo.WriteErrLog m_tagErrInfo
InitChart = False
End Function
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -