ucexit.ctl

VB制作的简单的基于access的停车管理数据库

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