?? ucexit.ctl
字號:
VERSION 5.00
Begin VB.UserControl ucexit
BackStyle = 0 '透明
ClientHeight = 7065
ClientLeft = 0
ClientTop = 0
ClientWidth = 9555
ScaleHeight = 7065
ScaleWidth = 9555
Begin VB.Frame Frame1
Height = 5775
Left = 840
TabIndex = 0
Top = 480
Width = 7815
Begin VB.CommandButton cmdcalculate
Caption = "計算"
Height = 495
Left = 4200
TabIndex = 16
ToolTipText = "計算車輛停車費用"
Top = 4800
Width = 1455
End
Begin VB.TextBox cost
Height = 375
Left = 2280
Locked = -1 'True
TabIndex = 14
Text = "0"
Top = 2880
Width = 3255
End
Begin VB.TextBox txtpkno
Height = 495
Left = 2280
TabIndex = 5
ToolTipText = "手動輸入車輛后4位號"
Top = 1200
Width = 2655
End
Begin VB.TextBox entertime1
Height = 495
Left = 2280
Locked = -1 'True
TabIndex = 4
Top = 1800
Width = 2655
End
Begin VB.ComboBox dtpexittime
BeginProperty DataFormat
Type = 0
Format = "2007-05-01 12:00:00"
HaveTrueFalseNull= 0
FirstDayOfWeek = 0
FirstWeekOfYear = 0
LCID = 2052
SubFormatType = 0
EndProperty
Height = 300
ItemData = "ucexit.ctx":0000
Left = 2280
List = "ucexit.ctx":0002
Locked = -1 'True
TabIndex = 3
Top = 2400
Width = 2655
End
Begin VB.TextBox remark1
Height = 1095
Left = 2280
TabIndex = 2
Top = 3480
Width = 3255
End
Begin VB.CommandButton record
Caption = "確定"
Height = 495
Left = 6120
TabIndex = 1
ToolTipText = "確定車輛離開"
Top = 4800
Width = 1335
End
Begin VB.Label Label9
Alignment = 2 'Center
Caption = "（元）"
Height = 375
Left = 5640
TabIndex = 15
Top = 3000
Width = 975
End
Begin VB.Label Label8
Caption = "費用："
Height = 375
Left = 840
TabIndex = 13
Top = 2880
Width = 1455
End
Begin VB.Label Label1
Alignment = 2 'Center
Caption = "車輛出場登記"
BeginProperty Font
Name = "幼圓"
Size = 12
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00000000&
Height = 495
Left = 1920
TabIndex = 12
Top = 480
Width = 3615
End
Begin VB.Label Label2
Caption = "編號："
Height = 375
Left = 600
TabIndex = 11
Top = 1200
Width = 1575
End
Begin VB.Label Label3
Caption = "入場時間："
Height = 375
Left = 600
TabIndex = 10
Top = 1800
Width = 1815
End
Begin VB.Label Label4
Caption = "出場場時間："
Height = 375
Left = 840
TabIndex = 9
Top = 2400
Width = 1575
End
Begin VB.Label Label5
Alignment = 2 'Center
Caption = "（手寫輸入）"
Height = 375
Left = 5280
TabIndex = 8
Top = 1320
Width = 1695
End
Begin VB.Label Label6
Alignment = 2 'Center
Caption = "（只讀，自動生成）"
Height = 375
Left = 5280
TabIndex = 7
Top = 1920
Width = 1695
End
Begin VB.Label Label7
Caption = "備注：（選填）"
Height = 375
Left = 840
TabIndex = 6
Top = 3480
Width = 1455
End
End
End
Attribute VB_Name = "ucexit"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Private Function calculateparkingcost(entertime As Date, exittime As Date) As Currency
Dim nhour As Double
nhour = DateDiff("h", entertime, exittime)
If nhour <= 0 Then
calculateparkingcost = 10
Exit Function
Else
calculateparkingcost = nhour * 10
End If
End Function
Private Sub cmdcalculate_Click()
Dim rsobj As New ADODB.Recordset
Dim sqlstr As String
Dim szpkno As String
Dim remark As String
Dim snow As String
Dim szentertime As String
Dim userid As String
szpkno = Replace(txtpkno.Text, "'", "'")
sqlstr = "select * from parkinginfo where parkingno='" & szpkno & "'"
Call rsobj.Open(sqlstr, dbcnn, adOpenKeyset, adLockReadOnly)
If rsobj.RecordCount <= 0 Then
MsgBox "輸入ID號有誤，請重新輸入!", vbExclamation, "提示！"
Exit Sub
End If
If rsobj("charge").Value > 0 Then
MsgBox "車輛已離開，請輸入正確的車輛ID號！", vbExclamation, "提示！"
Exit Sub
End If
cost.Text = calculateparkingcost(rsobj("entertime"), Now)
entertime1.Text = rsobj("entertime").Value
End Sub
Private Sub record_Click()
Dim addguest As New ADODB.Recordset
Dim sqlstr As String
Dim guestsex As String
Dim remark As String
Dim snow As String
Dim guestname As String
Dim guestreason As String
Dim userid As String
If cost.Text = 0 Then
MsgBox "請先按計算按鈕，再點擊確定鍵！", vbExclamation, "提示！"
Exit Sub
End If
guestname = Replace(Trim(txtpkno.Text), "'", "'")
userid = Replace(usernow.id, "'", "'")
remark = Replace(Trim(remark1.Text), "'", "'")
snow = Format(Now, "yyyy-mm-dd hh:mm:ss")
sqlstr = "update parkinginfo" & " set exittime=#" & snow & "#," & "charge = " & cost.Text & "," & "chargerecid='" & userid & "'" & " where parkingno='" & txtpkno.Text & "'"
dbcnn.Execute sqlstr
Call UserControl_Initialize
remark1.Text = ""
addrec (1)
MsgBox "操作記錄成功！", , "提示！"
End Sub
Private Sub UserControl_Initialize()
txtpkno.Text = Format(Year(Now), "0000") + Format(Month(Now), "00") + Format(Day(Now), "00")
dtpexittime.Text = Now
cost.Text = 0
End Sub
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -