frmparkingmanage.frm

小区物业管理系统

            Charset         =   134
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         _Version        =   393216
      End
      Begin VB.ComboBox cmbType 
         Height          =   300
         Left            =   840
         TabIndex        =   4
         Top             =   1800
         Width           =   855
      End
      Begin VB.ComboBox cmbNumber 
         Height          =   300
         Left            =   1080
         TabIndex        =   3
         Top             =   1404
         Width           =   1815
      End
      Begin VB.TextBox txtEnd 
         Height          =   270
         Left            =   1080
         MaxLength       =   13
         TabIndex        =   2
         Top             =   1041
         Width           =   1815
      End
      Begin VB.TextBox txtStart 
         Height          =   270
         Left            =   1080
         MaxLength       =   13
         TabIndex        =   1
         Top             =   678
         Width           =   1815
      End
      Begin VB.TextBox txtUser 
         DataSource      =   "Adodc1"
         Height          =   270
         Left            =   1080
         MaxLength       =   15
         TabIndex        =   0
         Top             =   315
         Width           =   1815
      End
      Begin VB.TextBox txtPrice 
         Height          =   300
         Left            =   2160
         MaxLength       =   4
         TabIndex        =   5
         Top             =   1800
         Width           =   735
      End
      Begin VB.Label Label3 
         AutoSize        =   -1  'True
         Caption         =   "离场时间"
         Height          =   180
         Left            =   360
         TabIndex        =   20
         Top             =   1086
         Width           =   720
      End
      Begin VB.Label Label2 
         AutoSize        =   -1  'True
         Caption         =   "入场时间"
         Height          =   180
         Left            =   360
         TabIndex        =   19
         Top             =   723
         Width           =   720
      End
      Begin VB.Label Label6 
         AutoSize        =   -1  'True
         Caption         =   "单价"
         Height          =   180
         Left            =   1800
         TabIndex        =   18
         Top             =   1860
         Width           =   360
      End
      Begin VB.Label Label5 
         AutoSize        =   -1  'True
         Caption         =   "类型"
         Height          =   180
         Left            =   360
         TabIndex        =   17
         Top             =   1860
         Width           =   360
      End
      Begin VB.Label Label1 
         AutoSize        =   -1  'True
         Caption         =   "用 户 名"
         Height          =   180
         Left            =   360
         TabIndex        =   16
         Top             =   360
         Width           =   720
      End
      Begin VB.Label Label4 
         AutoSize        =   -1  'True
         Caption         =   "车 位 号"
         Height          =   180
         Left            =   360
         TabIndex        =   15
         Top             =   1464
         Width           =   720
      End
   End
End
Attribute VB_Name = "ParkingManage"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim isParking As Boolean, objRsCopy As New Recordset
Private Sub Adodc1_MoveComplete(ByVal adReason As EventReasonEnum, _
        ByVal pError As Error, adStatus As EventStatusEnum, ByVal pRecordset As Recordset)
    With Adodc1.Recordset
    If Not isParking Then
        If .AbsolutePosition > 0 Then
            '显示停车记录数据
            txtUser = .Fields("用户名"):    txtStart = .Fields("入场时间")
            txtEnd = .Fields("离场时间"):   cmbNumber = .Fields("车位号")
            cmbType = .Fields("类型"):      txtPrice = .Fields("单价")
            cmdCharge.Enabled = True
            Adodc1.Caption = "当前记录：" & .AbsolutePosition & "/" & .RecordCount
        Else
            Adodc1.Caption = "无停车数据":  cmdCharge.Enabled = False
        End If
    Else
        Adodc1.Caption = "当前记录：" & .AbsolutePosition & "/" & .RecordCount
    End If
    End With
End Sub

Private Sub cmbNumber_Click()
    With objRsCopy
        .MoveFirst
        .Find "车位号='" & cmbNumber & "'"
        cmbType = .Fields("类型")
        txtPrice = .Fields("单价")
    End With
End Sub


Private Sub cmbQNumber_Click()
    '使选定车位停车记录成为当前记录
    Adodc1.Recordset.MoveFirst
    Adodc1.Recordset.Find "车位号='" & cmbQNumber & "'"
End Sub

Private Sub cmbQUser_Click()
    '使选定用户停车记录成为当前记录
    Adodc1.Recordset.MoveFirst
    Adodc1.Recordset.Find "用户名='" & cmbQUser & "'"
End Sub

Private Sub cmbType_Click()
    If isParking Then
        With objRsCopy           '显示该车位类型和价格
            .MoveFirst
            .Find "类型='" & cmbType & "'"
            If Not .EOF Then
                cmbNumber = .Fields("车位号")
                txtPrice = .Fields("单价")
            Else
                MsgBox "已无" & cmbType & "车位，重新选择类型！", vbCritical, "停车数据管理"
                cmbType.SetFocus
            End If
        End With
    End If
End Sub

Private Sub cmdCharge_Click()
    Dim sglSum As Single
    '根据当前显示的停车记录填写收费票据
    txtEnd = Format(Date, "Short date") & " " & Format(Time, "Short time")
    Label11 = Trim(txtUser)
    Label13 = Trim(cmbNumber)
    Label15 = Trim(cmbType)
    Label17 = Format(txtStart, "long date") & " " & Format(txtStart, "Short time")
    Label19 = Format(txtEnd, "long date") & " " & Format(txtEnd, "Short time")
    Label21 = Trim(txtPrice)
    sglSum = DateDiff("h", Label17, Label19)
    Label23 = Label21 & " * " & sglSum & " = " & (Val(Label21 * sglSum))
    Label24 = Format(Date, "Long date")
    If MsgBox("是否打印收费票据？", vbYesNo + vbInformation, "停车数据管理") = vbYes Then
        With ParkCharging
            .Label11 = Label11: .Label13 = Label13: .Label15 = Label15
            .Label17 = Label17: .Label19 = Label19: .Label21 = Label21
            .Label23 = Label23: .Label24 = Label24
            .PrintForm
        End With
    End If
End Sub

Private Sub cmdDelete_Click()
    With Adodc1.Recordset
    If Not .EOF Then
        If MsgBox("将删除" & cmbNumber & "车位停车数据，是否继续？", _
            vbCritical + vbYesNo, "停车数据管理") = vbYes Then
           .Fields("用户名") = ""
           .Fields("入场时间") = ""
           .Fields("离场时间") = ""
           .Update
            Lists_Refresh
        End If
    End If
    End With
End Sub

Private Sub cmdParking_Click()
    isParking = True
    cmbNumber.ListIndex = 0         '自动选择第一个空车位
    cmbType.Locked = False          '解除锁定，允许选择车位类型
    With objRsCopy          '显示该车位类型和价格
            .MoveFirst
            .Find "车位号='" & cmbNumber & "'"
            cmbType = .Fields("类型"): txtPrice = .Fields("单价")
    End With
    '设置默认的停车入场时间
    txtStart = Format(Date, "Short date") & " " & Format(Time, "Short time")
    txtEnd = "": txtUser = ""
    cmdParking.Enabled = False: cmdCharge.Enabled = False   '在保存新的停车数据之前禁用按钮
    cmdDelete.Enabled = False: Adodc1.Enabled = False
End Sub

Private Sub cmdRefresh_Click()
    Adodc1.Refresh
    Lists_Refresh           '恢复窗体初始状态
End Sub

Private Sub cmdSave_Click()
    Dim strUser$, strStart$, strEnd$, strPrice$, strNumber$
    '检验各个停车数据项是否正确
    If Trim(txtUser) = "" Then
        MsgBox "停车用户不能为空！", vbCritical, "停车数据管理"
        txtUser.SetFocus: Exit Sub
    ElseIf Trim(txtStart) = "" Or Not IsDate(txtStart) Then
        MsgBox "入场时间不能为空或者不是有效的日期时间！", vbCritical, "停车数据管理"
        txtsart.SetFocus: txtsart.setstart = 0: txtStart.SelLength = Len(txtStart)
        Exit Sub
    ElseIf Trim(cmbNumber) = "" Then
        MsgBox "车位号不能为空！", vbCritical, "停车数据管理"
        cmbNumber.SetFocus: Exit Sub
    ElseIf Trim(cmbType) = "" Then
        MsgBox "车位类型不能为空！", vbCritical, "停车数据管理"
        cmbType.SetFocus: Exit Sub
    ElseIf txtPrice = "" Then
        MsgBox "停车计时单价不能为空！", vbCritical, "停车数据管理"
        txtPrice.SetFocus: Exit Sub
    Else
        strUser = Trim(txtUser)   '保存当前停车数据
        strStart = Trim(txtStart)
        strEnd = Trim(txtEnd)
        strNumber = Trim(cmbNumber)
        strPrice = Trim(txtPrice)
        With Adodc1.Recordset
            If Not isParking Then
                .Fields("用户名") = ""      '清除当前记录停车数据
                .Fields("入场时间") = ""
                .Fields("离场时间") = ""
                .Update
            End If
            '根据车位号保存当前停车数据
            .Filter = ""
            .Find "车位号='" & strNumber & "'"
            If .EOF Then
                    MsgBox "车位号无效，可从车位号列表中选择空车位！", vbCritical, "停车数据管理"
                    cmbNumber.SetFocus
                    cmbNumber.SelStart = 0: cmbNumber.SelLength = Len(cmbNumber)
                Exit Sub
            End If
            '保存停车数据
            .Fields("用户名") = strUser
            .Fields("入场时间") = strStart
            .Fields("离场时间") = ""
            .Fields("单价") = strPrice
            .Update
            MsgBox "停车数据保存成功！", vbInformation, "停车数据管理"
        End With
        Set objRsCopy = Adodc1.Recordset.Clone  '更新副本
        Lists_Refresh           '恢复窗体初始状态
    End If
End Sub

Private Sub Form_Load()
    '添加车位类型列表,并设置该类型的停车单价
    cmbType.AddItem ("大"): cmbType.ItemData(cmbType.NewIndex) = 500
    cmbType.AddItem ("中"): cmbType.ItemData(cmbType.NewIndex) = 300
    cmbType.AddItem ("小"): cmbType.ItemData(cmbType.NewIndex) = 200
    Set objRsCopy = Adodc1.Recordset.Clone  '创建Adodc1记录集的副本
    Lists_Refresh           '恢复窗体初始状态
End Sub

Private Sub cmdExit_Click()
    Unload Me               '关闭停车数据管理窗体
End Sub


Private Sub Lists_Refresh()
    '从ADO Data的记录集副本中获得空车位号、停车用户名和已用车位号列表
    cmbQUser.Clear: cmbQNumber.Clear: cmbNumber.Clear       '清除列表
    With objRsCopy
        If .RecordCount > 0 Then
           .MoveFirst
            While Not .EOF
                If Trim(.Fields("入场时间")) <> "" Then
                    cmbQUser.AddItem (.Fields("用户名"))    '添加停车用户列表
                    cmbQNumber.AddItem (.Fields("车位号"))  '添加已用车位列表
                Else
                    cmbNumber.AddItem (.Fields("车位号"))   '添加空车位列表
                End If
                .MoveNext
            Wend
        End If
    End With
    With Adodc1.Recordset
        .Filter = "入场时间<>''"        '设置Adodc1记录集过滤器，仅显示停车数据
        If Not .EOF Then .MoveFirst     '显示第一个停车记录
    End With
    '初始化收费票据
    Label11 = "": Label13 = "": Label15 = "": Label17 = ""
    Label19 = "": Label21 = "": Label23 = "": Label24 = ""
    '设置停车用户和车位列表默认选项
    If cmbQUser.ListCount > 0 Then cmbQUser.ListIndex = 0
    If cmbQNumber.ListCount > 0 Then cmbQNumber.ListIndex = 0
    isParking = False           '恢复停车标记默认值
    cmdParking.Enabled = True   '恢复按钮及Adodc1默认状态
    cmdCharge.Enabled = True:  cmdDelete.Enabled = True:   Adodc1.Enabled = True
End Sub