frmsetroom.frm

智能门锁的程序,用于控制门锁发卡程序,是科布尔的

VERSION 5.00
Object = "{00028C01-0000-0000-0000-000000000046}#1.0#0"; "DBGRID32.OCX"
Begin VB.Form FrmSetRoom 
   Caption         =   "房间设置"
   ClientHeight    =   6285
   ClientLeft      =   255
   ClientTop       =   540
   ClientWidth     =   9255
   BeginProperty Font 
      Name            =   "宋体"
      Size            =   10.5
      Charset         =   134
      Weight          =   400
      Underline       =   0   'False
      Italic          =   0   'False
      Strikethrough   =   0   'False
   EndProperty
   LinkTopic       =   "Form1"
   ScaleHeight     =   6285
   ScaleWidth      =   9255
   Begin VB.CommandButton CmdProduce 
      Caption         =   "产生房间号"
      Height          =   375
      Left            =   3720
      TabIndex        =   8
      Top             =   2640
      Width           =   1335
   End
   Begin MSDBGrid.DBGrid DBGrid1 
      Bindings        =   "FrmSetRoom.frx":0000
      Height          =   5415
      Left            =   5280
      OleObjectBlob   =   "FrmSetRoom.frx":0014
      TabIndex        =   7
      Top             =   240
      Width           =   3495
   End
   Begin VB.ListBox LstRoomBak 
      Columns         =   4
      Height          =   5100
      ItemData        =   "FrmSetRoom.frx":084B
      Left            =   120
      List            =   "FrmSetRoom.frx":084D
      TabIndex        =   2
      Top             =   240
      Width           =   3255
   End
   Begin VB.TextBox TxtFloorNumber 
      Height          =   375
      Left            =   4440
      MaxLength       =   2
      TabIndex        =   1
      Top             =   1440
      Width           =   735
   End
   Begin VB.TextBox TxtBuildingNumber 
      Height          =   375
      Left            =   4440
      MaxLength       =   2
      TabIndex        =   0
      Top             =   840
      Width           =   735
   End
   Begin VB.Data Data1 
      Caption         =   "Data1"
      Connect         =   "Access"
      DatabaseName    =   "C:\ICLock\Lock312\ICData.mdb"
      DefaultCursorType=   0  'DefaultCursor
      DefaultType     =   2  'UseODBC
      Exclusive       =   0   'False
      Height          =   435
      Left            =   3720
      Options         =   0
      ReadOnly        =   0   'False
      RecordsetType   =   1  'Dynaset
      RecordSource    =   "Room"
      Top             =   120
      Visible         =   0   'False
      Width           =   1455
   End
   Begin VB.CommandButton CmdCancel 
      Caption         =   "取消"
      Height          =   375
      Left            =   3720
      TabIndex        =   4
      Top             =   4080
      Width           =   1335
   End
   Begin VB.CommandButton CmdDelete 
      Caption         =   "删除"
      Enabled         =   0   'False
      Height          =   375
      Left            =   3720
      TabIndex        =   3
      Top             =   3360
      Width           =   1335
   End
   Begin VB.Label Label1 
      Caption         =   "说明:楼号、楼层输入字。"
      Height          =   615
      Left            =   240
      TabIndex        =   9
      Top             =   5520
      Width           =   4815
   End
   Begin VB.Label Label3 
      Caption         =   "楼层(01)"
      Height          =   255
      Left            =   3480
      TabIndex        =   6
      Top             =   1440
      Width           =   855
   End
   Begin VB.Label LblBuildingNumber 
      Caption         =   "楼号(01)"
      Height          =   375
      Left            =   3480
      TabIndex        =   5
      Top             =   840
      Width           =   855
   End
End
Attribute VB_Name = "FrmSetRoom"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim tRoomNumber As String
'获得楼号字符
Function GetBuildingNumber(pBuildingNumber As String) As String
      Dim sTmp As String
      GetBuildingNumber = ""
      If Len(pBuildingNumber) = 1 Then
         If pBuildingNumber = "0" Then
               GetBuildingNumber = ""
            Else
               GetBuildingNumber = pBuildingNumber
          End If
      End If
      If Len(pBuildingNumber) = 2 Then
         If Mid(pBuildingNumber, 1, 1) = "0" Then
               GetBuildingNumber = Mid(pBuildingNumber, 2, 1)
            Else
               GetBuildingNumber = pBuildingNumber
          End If
      End If
End Function
'获得楼层字符,Failure,Return value is space
Function GetFloorNumber(pFloorNumber As String) As String
 Dim sTmp As String
      GetFloorNumber = ""
      If Len(pFloorNumber) = 1 Then
         If TxtBuildingNumber = "" Then
            If pFloorNumber = "0" Then
                 GetFloorNumber = ""
              Else
                 GetFloorNumber = pFloorNumber
            End If
           Else
            If pFloorNumber = "0" Then
                 GetFloorNumber = ""
              Else
                 GetFloorNumber = "0" & pFloorNumber
            End If
          End If
      End If
      If Len(pFloorNumber) = 2 Then
         GetFloorNumber = pFloorNumber
      End If
End Function

'对RC_Building添加楼号记录
Function RC_Building_Add(ByVal pBuildingNumber As String) As Boolean
    Dim sTmp As String
    On Error GoTo ErrHand:
    sTmp = "BuildingNumber='" & pBuildingNumber & "'"
    With RC_Building
          If Not (.BOF And .EOF) Then
             .MoveFirst
             .FindLast sTmp
             If Not .NoMatch Then
                RC_Building_Add = False
                Exit Function
             End If
          End If
         .AddNew
         .Fields("BuildingNumber") = pBuildingNumber
         .Update
    End With
    RC_Building_Add = True
    Exit Function
ErrHand:
    RC_Building_Add = False
End Function
'对RC_FLOOR添加楼层记录
Function RC_Floor_Add(ByVal pBuildingNumber As String, ByVal pFloorNumber As String) As Boolean
    Dim sTmp, sTmp1, sTmp2 As String
    On Error GoTo ErrHand:
    If pBuildingNumber = "" Then
        sTmp1 = "no"
       Else
        sTmp1 = pBuildingNumber
    End If
    sTmp = "BuildingNumber='" & sTmp1 & "' and FloorNumber='" & pFloorNumber & "'"
    With RC_Floor
          If Not (.BOF And .EOF) Then
             .MoveFirst
             .FindLast sTmp
             If Not .NoMatch Then
                RC_Floor_Add = False
                Exit Function
             End If
          End If
         .AddNew
         .Fields("BuildingNumber") = sTmp1
         .Fields("FloorNumber") = pFloorNumber
         .Update
    End With
    RC_Floor_Add = True
    Exit Function
ErrHand:
    RC_Floor_Add = False
End Function
'对RC_Room删除房间记录
Function RC_Room_Del(ByVal pShortRoomNumber As String) As Boolean
    Dim sTmp  As String
    On Error GoTo ErrHand:
       sTmp = "ShortRoomNumber='" & pShortRoomNumber & "'"
       With RC_Room
           If Not (.BOF And .EOF) Then
              .MoveFirst
              .FindLast sTmp
              If Not .NoMatch Then
                 .Delete
                 RC_Room_Del = True
                 Exit Function
              End If
            End If
        End With
         RC_Room_Del = False
        Exit Function
ErrHand:
        RC_Room_Del = False
End Function
'对RC_Room添加房间记录
Function RC_Room_Add(ByVal pBuildingNumber As String, ByVal pFloorNumber As String, ByVal pRoomNumber As String) As Boolean
    Dim sTmp, sBuildingNumber As String
    On Error GoTo ErrHand:
       sTmp = "ShortRoomNumber='" & pBuildingNumber & pFloorNumber & pRoomNumber & "'"
       With RC_Room
           If Not (.BOF And .EOF) Then
              .MoveFirst
              .FindLast sTmp
              If Not .NoMatch Then
                 Room_Add = False
                 Exit Function
              End If
           End If
           If pBuildingNumber = "" Then
                 sBuildingNumber = "no"
              Else
                 sBuildingNumber = pBuildingNumber
           End If
           .AddNew
           .Fields("BuildingNumber") = sBuildingNumber
           .Fields("FloorNumber") = pFloorNumber
           .Fields("RoomNumber") = pRoomNumber
           .Fields("ShortRoomNumber") = pBuildingNumber & pFloorNumber & pRoomNumber
           .Update
        End With
        Call RC_EventLog_Add("添加房间" & pBuildingNumber & pFloorNumber & pRoomNumber, gUserName, "")
        RC_Room_Add = True
        Exit Function
ErrHand:
        RC_Room_Add = False
End Function

Private Sub CmdCancel_Click()
    Unload Me
End Sub

Private Sub CmdDelete_Click()
    If tRoomNumber = "" Then
           MsgBox "无可删除项！", vbInformation + vbOKOnly, "提示"
       Else
           If RC_Room_Del(tRoomNumber) Then
              Data1.Refresh
              Call RC_EventLog_Add("删除房间" & tRoomNumber, gUserName, "")
           End If
    End If
End Sub


Private Sub CmdProduce_Click()
     Dim sBuildingNumber, sFloorNumber, sRoomNumber As String
     Dim sTmp As String
     Dim iTmp As Integer
     LstRoomBak.Clear
     If TxtFloorNumber = "" Then
        MsgBox "楼层或类型非空！", vbInformation + vbOKOnly, "提示"
        Exit Sub
     End If
     sBuildingNumber = GetBuildingNumber(TxtBuildingNumber.Text)
     If (TxtBuildingNumber.Text <> "") Then
        If (sBuildingNumber = "") Then
            MsgBox "楼号输入错误！", vbInformation + vbOKOnly, "提示"
            Exit Sub
        End If
     End If
     sFloorNumber = GetFloorNumber(TxtFloorNumber.Text)
     If sFloorNumber = "" Then
            MsgBox "楼层输入错误！", vbInformation + vbOKOnly, "提示"
            Exit Sub
     End If
     If (RC_Room.BOF And RC_Room.EOF) Then '房间库内无房间记录
             For i = 1 To 99
                 sTmp = 100 + i
                 sRoomNumber = Right(Trim(sTmp), 2)
                 LstRoomBak.AddItem sRoomNumber
             Next
         Else
             For i = 1 To 99
                 sTmp = 100 + i
                 sRoomNumber = Right(Trim(sTmp), 2)
                 sTmp = "ShortRoomNumber='" & sBuildingNumber & sFloorNumber & sRoomNumber & "'"
                 RC_Room.MoveFirst
                 RC_Room.FindLast sTmp
                 If RC_Room.NoMatch Then  '判断该房间号存在否,exist true,no exist false
                        LstRoomBak.AddItem sRoomNumber '该房间不存在的添加
                 End If
             Next
     End If

End Sub

Private Sub DBGrid1_RowColChange(LastRow As Variant, ByVal LastCol As Integer)
    tRoomNumber = DBGrid1.Columns(0)
    If tRoomNumber = "" Then
       CmdDelete.Enabled = False
       Else
       CmdDelete.Enabled = True
    End If
End Sub

Private Sub Form_Load()
     Data1.DatabaseName = SystemDir & "ICData.mdb"
     If Not gBuildingLog Then
        TxtBuildingNumber.Enabled = False
     End If
End Sub
Private Sub LstRoomBak_DblClick()
     Dim sBuildingNumber, sFloorNumber, sRoomNumber, sTmp As String
     Dim iTmp As Integer
     If TxtFloorNumber.Text = "" Then
           MsgBox "楼层非空", vbInformation + vbOKOnly, "提示"
           Exit Sub
     End If
     
     sBuildingNumber = GetBuildingNumber(TxtBuildingNumber.Text)
     If (TxtBuildingNumber.Text <> "") Then
        If (sBuildingNumber = "") Then
            MsgBox "楼号输入错误！", vbInformation + vbOKOnly, "提示"
            Exit Sub
        End If
     End If
     
     sFloorNumber = GetFloorNumber(TxtFloorNumber.Text)
     If sFloorNumber = "" Then
            MsgBox "楼层输入错误！", vbInformation + vbOKOnly, "提示"
            Exit Sub
     End If
     
     If gBuildingLog Then '系统第一次确定有无楼号,默认有楼号
        If TxtBuildingNumber <> "" Then '楼号栏目有输入
               RC_Building_Add (sBuildingNumber) '添加楼号
           Else '楼号栏目无输入
               gBuildingLog = False '无楼号
               '将无楼号逻辑记录SYSPARA RECORDSET
               With RC_SysPara
                    If Not (.EOF And .BOF) Then
                         .MoveFirst
                         .Edit
                         .Fields("BuildingLog") = False
                         .Update
                       Else
                         .AddNew
                         .Fields("BuildingLog") = False
                         .Update
                    End If
               End With
        End If
    End If '系统在前一次确定无楼号
    Call RC_Floor_Add(sBuildingNumber, sFloorNumber) '添加楼层
    sRoomNumber = LstRoomBak.Text
    If RC_Room_Add(sBuildingNumber, sFloorNumber, sRoomNumber) Then
       LstRoomBak.RemoveItem (LstRoomBak.ListIndex)
       Data1.Refresh
    End If
End Sub
Private Sub TxtBuildingNumber_Change()
    LstRoomBak.Clear
    TxtBuildingNumber.Text = StrConv(TxtBuildingNumber.Text, vbUpperCase)
End Sub
Private Sub TxtFloorNumber_Change()
    If gBuildingLog And (TxtBuildingNumber.Text = "") Then
        MsgBox "楼号非空！", vbInformation + vbOKOnly, "提示"
        TxtFloorNumber.Text = ""
        Exit Sub
    End If
    LstRoomBak.Clear
    TxtFloorNumber.Text = StrConv(TxtFloorNumber.Text, vbUpperCase)
End Sub