?? frmclog.frm
字號:
VERSION 5.00
Begin VB.Form frmClog
BorderStyle = 1 'Fixed Single
Caption = "設備使用"
ClientHeight = 5940
ClientLeft = 45
ClientTop = 330
ClientWidth = 6975
LinkTopic = "Form1"
MaxButton = 0 'False
MDIChild = -1 'True
MinButton = 0 'False
ScaleHeight = 5940
ScaleWidth = 6975
Begin VB.CommandButton cmdEnd
Caption = "下機"
Height = 495
Left = 2160
TabIndex = 14
Top = 5040
Width = 1215
End
Begin VB.Timer Timer1
Interval = 1000
Left = 6480
Top = 2520
End
Begin VB.Frame Frame1
Height = 4575
Left = 600
TabIndex = 3
Top = 240
Width = 5775
Begin VB.CommandButton cmdCheckUser
Caption = "檢驗"
Height = 375
Left = 4200
TabIndex = 16
Top = 1200
Width = 735
End
Begin VB.CommandButton cmdApply
Caption = "申請"
Height = 375
Left = 4200
TabIndex = 15
Top = 480
Width = 735
End
Begin VB.TextBox txtStartTime
Appearance = 0 'Flat
Height = 375
Left = 2400
Locked = -1 'True
MaxLength = 50
TabIndex = 11
Top = 2160
Width = 2175
End
Begin VB.TextBox txtEndTime
Appearance = 0 'Flat
Height = 375
Left = 2400
Locked = -1 'True
MaxLength = 50
TabIndex = 10
Top = 2760
Width = 2175
End
Begin VB.TextBox txtCharge
Appearance = 0 'Flat
Height = 375
Left = 2400
Locked = -1 'True
TabIndex = 9
Top = 3360
Width = 2175
End
Begin VB.TextBox txtUID
Appearance = 0 'Flat
Height = 375
Left = 2400
MaxLength = 6
TabIndex = 7
Top = 1200
Width = 1575
End
Begin VB.TextBox txtEID
Appearance = 0 'Flat
Height = 375
Left = 2400
Locked = -1 'True
MaxLength = 5
TabIndex = 4
Top = 480
Width = 1575
End
Begin VB.Label Label5
Appearance = 0 'Flat
AutoSize = -1 'True
BackColor = &H80000005&
BackStyle = 0 'Transparent
Caption = "開始時間："
BeginProperty Font
Name = "楷體_GB2312"
Size = 14.25
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H80000008&
Height = 285
Left = 720
TabIndex = 13
Top = 2280
Width = 1575
End
Begin VB.Label Label4
Appearance = 0 'Flat
AutoSize = -1 'True
BackColor = &H80000005&
BackStyle = 0 'Transparent
Caption = "結束時間："
BeginProperty Font
Name = "楷體_GB2312"
Size = 14.25
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H80000008&
Height = 285
Left = 720
TabIndex = 12
Top = 2880
Width = 1575
End
Begin VB.Label Label6
Appearance = 0 'Flat
AutoSize = -1 'True
BackColor = &H80000005&
BackStyle = 0 'Transparent
Caption = "應收費用："
BeginProperty Font
Name = "楷體_GB2312"
Size = 14.25
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H80000008&
Height = 285
Left = 720
TabIndex = 8
Top = 3480
Width = 1575
End
Begin VB.Label Label2
Appearance = 0 'Flat
AutoSize = -1 'True
BackColor = &H80000005&
BackStyle = 0 'Transparent
Caption = "設備編號："
BeginProperty Font
Name = "楷體_GB2312"
Size = 14.25
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H80000008&
Height = 285
Left = 720
TabIndex = 6
Top = 600
Width = 1575
End
Begin VB.Label Label1
Appearance = 0 'Flat
AutoSize = -1 'True
BackColor = &H80000005&
BackStyle = 0 'Transparent
Caption = "用戶編號："
BeginProperty Font
Name = "楷體_GB2312"
Size = 14.25
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H80000008&
Height = 285
Left = 720
TabIndex = 5
Top = 1320
Width = 1575
End
End
Begin VB.CommandButton cmdSearch
Caption = "查詢"
Height = 495
Left = 3600
TabIndex = 2
Top = 5040
Width = 1215
End
Begin VB.CommandButton cmdStart
Caption = "上機"
Height = 495
Left = 720
TabIndex = 1
Top = 5040
Width = 1215
End
Begin VB.CommandButton cmdCancel
Caption = "取消"
Height = 495
Left = 5040
TabIndex = 0
Top = 5040
Width = 1215
End
End
Attribute VB_Name = "frmClog"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'
'設備使用記錄
'開始時候添加記錄，用戶使用完畢修改記錄
'
Private TimerEnable As Boolean
Private Sub cmdApply_Click()
'獲取一個空閑的機器號
Dim strSql As String
Dim rsE As New ADODB.Recordset
strSql = "select top 1 EID from EQUIPMENT where state='E'"
Set rsE = objDBOpt.getRecords(strSql)
If rsE Is Nothing Then
MsgBox "數據查詢錯誤！"
Exit Sub
End If
If rsE.BOF And rsE.EOF Then
MsgBox "沒有空閑的機器！"
Exit Sub
End If
Me.txtEID.Text = setNotNull(rsE.Fields("EID").value)
Me.cmdApply.Enabled = False
Me.cmdStart.Enabled = True
rsE.Close
Set rsE = Nothing
End Sub
Private Sub cmdCancel_Click()
Unload Me
End Sub
Private Sub cmdCheckUser_Click()
'檢驗用戶是否存在
Dim strUID As String
strUID = Me.txtUID.Text
If IsUserExist(strUID) Then
MsgBox "該用戶通過驗證！"
Else
MsgBox "該用戶不存在！"
End If
End Sub
Private Sub cmdEnd_Click()
'下機，進行費用結算
Dim strUID As String
Dim strEID As String
Dim dblCharge As Double
Dim dblBalance As Double
Dim dtStartTime As Date
Dim dtEndTime As Date
Dim strSql As String
Dim rs As ADODB.Recordset
strUID = Me.txtUID.Text
strEID = Me.txtEID.Text
dblCharge = Me.txtCharge.Text
dtStartTime = Me.txtStartTime.Text
dtEndTime = Me.txtEndTime.Text
'檢查用戶余額(Cuser－》BALANCE )是否大于應收款
strSql = "select * from CUser where UID='" & strUID & "'"
Set rs = objDBOpt.getRecords(strSql, 1, 3)
If rs Is Nothing Then
MsgBox "數據庫查詢出錯！"
Exit Sub
End If
If Not (rs.EOF And rs.BOF) Then
dblBalance = setNotNull(rs.Fields("balance").value, 0)
objDBOpt.ModiRecord "Cuser", "balance", dblBalance - dblCharge, "uid='" & strUID & "'"
If dblBalance < dblCharge Then
MsgBox "用戶余額不足！"
End If
End If
'更新 Equipment 表
objDBOpt.ModiRecord "EQUIPMENT", "State", "'E'", "EID='" & strEID & "'"
objDBOpt.ModiRecord "EQUIPMENT", "STARTTIME", "'" & dtStartTime & "'", "EID='" & strEID & "'"
'更新 Charge 表
objDBOpt.ModiRecord "CHARGE", "Charge", dblCharge, "uid='" & strUID & "' and starttime=endtime"
objDBOpt.ModiRecord "CHARGE", "EndTime", "'" & dtEndTime & "'", "uid='" & strUID & "' and starttime=endtime"
'更新 Clog 表
objDBOpt.ModiRecord "CLOG", "EndTime", "'" & dtEndTime & "'", "uid='" & strUID & "' and starttime=endtime"
MsgBox "操作成功！"
Call initForm
End Sub
Private Sub cmdSearch_Click()
'用戶下機時，根據用戶ID查詢機器的使用信息
Dim strUID As String
Dim strEID As String
Dim dtStartTime As Date
Dim dtEndTime As Date
Dim dblCharge As Double
Dim rsU As ADODB.Recordset
Dim strSql As String
strUID = Trim(Me.txtUID.Text)
If strUID = "" Then
MsgBox "請填寫用戶編號！"
Exit Sub
End If
'檢查用戶是否上機
strSql = "select * from charge where UID='" & strUID & "' and starttime=endtime"
Set rsU = objDBOpt.getRecords(strSql)
If rsU Is Nothing Then
MsgBox "數據查詢失敗！"
Exit Sub
End If
If rsU.EOF And rsU.BOF Then
MsgBox "沒有找到用戶上機信息！"
Exit Sub
End If
'如果找到用戶上機信息
Me.cmdEnd.Enabled = True
Me.Timer1.Enabled = False
strEID = setNotNull(rsU.Fields("EID").value)
strCType = setNotNull(rsU.Fields("CType").value, "O")
dtStartTime = setNotNull(rsU.Fields("StartTime").value, Now)
dtEndTime = Now()
dblCharge = getCharge(dtStartTime, dtEndTime, strCType)
Me.txtEID.Text = strEID
Me.txtStartTime.Text = dtStartTime
Me.txtEndTime.Text = dtEndTime
Me.txtCharge.Text = dblCharge
rsU.Close
Me.txtUID.Locked = True
End Sub
Private Sub cmdStart_Click()
'上機，分配機器給用戶
Dim strEID As String
Dim strUID As String
Dim dtStartTime As Date
Dim strCType As String
Dim rst As ADODB.Recordset
strEID = Trim(Me.txtEID.Text)
strUID = Trim(Me.txtUID.Text)
dtStartTime = Trim(Me.txtStartTime.Text)
If strUID = "" Then
MsgBox "請填寫用戶編號！"
Exit Sub
End If
'檢查是否有該用戶
If IsUserExist(strUID) Then
'獲取用戶收費方式
Set rst = objDBOpt.getRecords("select CType from CUser where UID='" & strUID & "'")
If rst Is Nothing Then
MsgBox "數據查詢錯誤"
Exit Sub
End If
If rst.EOF Or rst.BOF Then
MsgBox "沒有找到用戶相關信息！"
Exit Sub
End If
strCType = setNotNull(rst.Fields("CType").value, "O")
rst.Close
'修改設備使用狀態
objDBOpt.ModiRecord "EQUIPMENT", "State", "'U'", "EID='" & strEID & "'"
objDBOpt.ModiRecord "EQUIPMENT", "STARTTIME", "'" & dtStartTime & "'", "EID='" & strEID & "'"
'CHARGE 表分別加入相應的記錄
objDBOpt.AddRecord "CHARGE", "UID,EID,CType,StartTime,EndTime", "'" & strUID & "','" & strEID & "','" & strCType & "','" & dtStartTime & "','" & dtStartTime & "'"
'CLOG 表分別加入相應的記錄
objDBOpt.AddRecord "CLOG", "UID,EID,StartTime,EndTime", "'" & strUID & "','" & strEID & "','" & dtStartTime & "','" & dtStartTime & "'"
MsgBox "數據添加成功！"
Else
MsgBox "該用戶不存在！"
End If
Call initForm
End Sub
Private Sub Form_Load()
Call initForm
End Sub
Private Sub Timer1_Timer()
If TimerEnable Then
Me.txtStartTime.Text = CStr(Now())
End If
Me.txtEndTime.Text = Now()
End Sub
Private Function IsUserExist(ByVal strUID As String)
IsUserExist = objDBOpt.IsRecordExist("CUser", "UID='" & strUID & "'")
End Function
Private Function getCharge(ByVal dtStartTime As Date, ByVal dtEndTime As Date, Optional ByVal strCType = "O")
'計算應收費用的函數，如果計價方式是可設定的，可以修改該函數
Dim nPrice As Integer
Dim nMinute As Double
If LCase(strCType) = "u" Then
nPrice = 1
ElseIf LCase(strCType) = "h" Then '
nPrice = 2
Else
nPrice = 0
End If
nMinute = DateDiff("n", dtStartTime, dtEndTime)
getCharge = nMinute * nPrice
If nMinute < 1 Then
getCharge = 1
End If
End Function
Private Function initForm()
resetForm Me
Me.cmdEnd.Enabled = False
Me.cmdApply.Enabled = True
Me.cmdStart.Enabled = False
Me.txtUID.Locked = False
Me.txtCharge.Text = 0
Me.txtStartTime.Text = Now()
Me.txtEndTime.Text = Now()
TimerEnable = True
Me.Timer1.Enabled = True
End Function
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -