guestmanager.ctl

星级酒店管理系统（附带系统自写控件源码）

Private Sub cmdCancelX_Click()
    
  AddStore.Enabled = True
  StoreDelete.Enabled = True
  StoreModify.Enabled = True
  ExitButton.Enabled = True
  Picture3.Visible = False
  Grid1.Visible = True
  StoreModifyName.Text = ""
  StoreModify.SetFocus
  Exit Sub

End Sub

Private Sub cmdModifySave_Click()

On Error GoTo DelErr
  
If UCase(Trim(sOld_Name)) = UCase(Trim(StoreModifyName.Text)) Then
   MsgBox "No change,don't save？  ", vbInformation, "Power by Silong."
   StoreModifyName.SetFocus
   Exit Sub
End If
   
'查找名称是否存在，如果存在不能更新
'保存记录
  Dim DB As Database, EF As Recordset, RecStr As String
  Set DB = OpenDatabase(m_sDatabaseFile, 0, 0, m_sDatabasePassword)
  Set EF = DB.OpenRecordset(m_sTableName, dbOpenDynaset)
      RecStr = "Class='" & Trim(StoreModifyName.Text) & "'"
      EF.FindFirst RecStr
      If Not EF.NoMatch Then
         EF.Close
         DB.Close
         MsgBox "Classify name is exist.   " & vbCrLf & vbCrLf & "  change it  ......    ", vbOKOnly + 64, "Duplicate Classify Name."
         StoreModifyName.SetFocus
         StoreModifyName.SelStart = 0
         StoreModifyName.SelLength = Len(StoreModifyName)
         Exit Sub
      End If
 
     m_sFieldValue = Grid1.Text  '原来的名称
     m_sOldFieldValue = Trim(StoreModifyName)   '新名称
 
 '修改记录
     RecStr = "Update " & m_sTableName & " Set Class='" & sOldFieldValue & "' Where Class='" & sFieldValue & "'"
     DB.Execute RecStr
        '修改操作的SQL，赋于新值
         If DelSQL1 <> "" Then
            DB.Execute UpdateSQL1 & "'" & sOldFieldValue & "' Where " & UpdateField1 & "='" & sFieldValue & "'"
         End If
         If DelSQL2 <> "" Then
            DB.Execute UpdateSQL2 & "'" & sOldFieldValue & "' Where " & UpdateField2 & "='" & sFieldValue & "'"
         End If
         If DelSQL3 <> "" Then
            DB.Execute UpdateSQL3 & "'" & sOldFieldValue & "' Where " & UpdateField3 & "='" & sFieldValue & "'"
         End If
         If DelSQL4 <> "" Then
            DB.Execute UpdateSQL4 & "'" & sOldFieldValue & "' Where " & UpdateField4 & "='" & sFieldValue & "'"
         End If
         If DelSQL5 <> "" Then
            DB.Execute UpdateSQL5 & "'" & sOldFieldValue & "' Where " & UpdateField5 & "='" & sFieldValue & "'"
         End If
         DB.Close
         
'更新数据
 Grid1.Text = sOldFieldValue
 
 AddStore.Enabled = True
 StoreDelete.Enabled = True
 ExitButton.Enabled = True
 StoreModify.Enabled = True
 Picture3.Visible = False
 Grid1.Visible = True
 StoreModify.SetFocus
 
 Exit Sub
DelErr:
  MsgBox "Modify classify err:" & Err.Description, vbExclamation, "Power by Silong."
  Exit Sub
End Sub

Private Sub Command1_Click(Index As Integer)

    On Error GoTo Add_Err
    
If Index = 1 Then
    AddStore.Enabled = True
    StoreDelete.Enabled = True
    StoreModify.Enabled = True
    ExitButton.Enabled = True
    Picture2.Visible = False
    Grid1.Visible = True
    StoreName.Text = ""
    AddStore.SetFocus
    Exit Sub
End If
'保存记录
  Dim DB As Database, EF As Recordset, RecStr As String
  Set DB = OpenDatabase(m_sDatabaseFile, 0, 0, m_sDatabasePassword)
  Set EF = DB.OpenRecordset(m_sTableName, dbOpenDynaset)
      RecStr = "Class='" & Trim(StoreName.Text) & "'"
      EF.FindFirst RecStr
      If EF.NoMatch Then
         EF.AddNew
         EF.Fields("Class") = Trim(StoreName.Text)
         EF.Update
         EF.Close
         DB.Close
         StoreName.Text = ""
      Else
         EF.Close
         DB.Close
         MsgBox "Classify name is exist!   " & vbCrLf & vbCrLf & "  change it ......    ", vbOKOnly + 64, "Duplicate classify name."
         StoreName.Text = ""
         StoreName.SetFocus
         Exit Sub
      End If
'配置网格
Grid1.Visible = False
Grid1.Clear
Grid1.Cols = 2
Grid1.FormatString = "^ NO |^ " & sTypeName & "Name "
Grid1.ColWidth(0) = 600
Grid1.ColWidth(1) = 3500
Dim HH As Integer
    Set DB = OpenDatabase(m_sDatabaseFile, 0, 0, m_sDatabasePassword)
    Set EF = DB.OpenRecordset(m_sTableName, dbOpenTable)
        Grid1.Rows = EF.RecordCount + 1
    Set EF = DB.OpenRecordset("Select * From " & m_sTableName, dbOpenDynaset)
        HH = 1
        Do While Not EF.EOF()
           Grid1.Row = HH
           Grid1.Col = 1
           Grid1.CellAlignment = 1
        If Not IsNull(EF.Fields(0).Value) Then
           Grid1.Text = EF.Fields(0).Value
        End If
          EF.MoveNext
          HH = HH + 1
        Loop
        DB.Close
For HH = 1 To Grid1.Rows - 1
    Grid1.Row = HH
    Grid1.Col = 0
    Grid1.Text = HH
    If Len(Grid1.Text) = 1 Then
     Grid1.Text = "0" + Grid1.Text
     End If
 Next
 Grid1.Col = 1
 Grid1.Row = 1
 Grid1.ColSel = 1
 Grid1.Visible = True
 AddStore.Enabled = True
 StoreDelete.Enabled = True
 StoreModify.Enabled = True
 ExitButton.Enabled = True
 Picture2.Visible = False
 AddStore.SetFocus
 
 Exit Sub
Add_Err:
 MsgBox "Sorry,don't add this classify.  ", vbInformation, "Power by Silong."
 
End Sub

Private Sub ExitButton_Click()

 Unload UserControl.Parent

End Sub

Private Sub StoreDelete_Click()

On Error GoTo DelErr
If Grid1.Text = "" Or Grid1.MouseCol = 0 Or Grid1.MouseRow = 0 Then Exit Sub
   sFieldValue = Grid1.Text
Dim QR As Integer
    QR = MsgBox("Are you Delete?[" & Grid1.Text & "](Y/N)", vbYesNo + 16, "Confirm")
    If QR = 7 Then
       Exit Sub
    End If
'删除记录
  Dim DB As Database, RecStr As String
  Set DB = OpenDatabase(m_sDatabaseFile, 0, 0, m_sDatabasePassword)
         RecStr = "Class='" & Grid1.Text & "'"
         RecStr = "Delete * From " & m_sTableName & " Where " & RecStr
         DB.Execute RecStr
        '删除一些操作的SQL
         If DelSQL1 <> "" Then
            DB.Execute DelSQL1 & " Where " & DelField1 & "='" & sFieldValue & "'"
         End If
         If DelSQL2 <> "" Then
            DB.Execute DelSQL2 & " Where " & DelField2 & "='" & sFieldValue & "'"
         End If
         If DelSQL3 <> "" Then
            DB.Execute DelSQL3 & " Where " & DelField3 & "='" & sFieldValue & "'"
         End If
         If DelSQL4 <> "" Then
            DB.Execute DelSQL4 & " Where " & DelField4 & "='" & sFieldValue & "'"
         End If
         If DelSQL5 <> "" Then
            DB.Execute DelSQL5 & " Where " & DelField5 & "='" & sFieldValue & "'"
         End If
         DB.Close
'移去删除的行
 Grid1.RemoveItem Grid1.Row

 Exit Sub
DelErr:
  MsgBox "Delete error：" & Err.Description, vbExclamation, "Power by Silong."
  Exit Sub
  
End Sub

Private Sub StoreModify_Click()

If Grid1.Text = "" Or Grid1.MouseCol = 0 Or Grid1.MouseRow = 0 Then Exit Sub

Grid1.Visible = False
AddStore.Enabled = False
StoreDelete.Enabled = False
ExitButton.Enabled = False
StoreModify.Enabled = False
Picture2.Visible = False
Picture3.Visible = True
StoreModifyName.Text = Grid1.Text
sOld_Name = StoreModifyName.Text
sOldFieldValue = sOld_Name
StoreModifyName.SetFocus
StoreModifyName.SelStart = 0
StoreModifyName.SelLength = Len(StoreModifyName.Text)
Label1(2).Caption = "Enter new〖" & sTypeName & "〗name"
Label1(3).Caption = "Enter new〖" & sTypeName & "〗name"

End Sub

Private Sub StoreModifyName_Change()

If Trim(StoreModifyName.Text) = "" Then
   cmdModifySave.Enabled = False
   Else
   cmdModifySave.Enabled = True
End If

End Sub

Private Sub StoreModifyName_KeyPress(KeyAscii As Integer)

If KeyAscii = 13 Then
   SendKeys "{tab}"
End If

End Sub

Private Sub StoreName_Change()

If Trim(StoreName) <> "" Then
   Command1(0).Enabled = True
   Else
   Command1(0).Enabled = False
End If

End Sub

Private Sub StoreName_KeyPress(KeyAscii As Integer)

If KeyAscii = 13 Then
   SendKeys "{tab}"
End If

End Sub

Private Sub UserControl_Resize()

If UserControl.Width <> 6285 Then
   UserControl.Width = 6285
End If
If UserControl.Height <> 3855 Then
   UserControl.Height = 3855
End If

End Sub
''注意！不要删除或修改下列被注释的行！
''MemberInfo=13,0,0,0
'Public Property Get sDatabaseFile() As String
'    sDatabaseFile = m_sDatabaseFile
'End Property
'
'Public Property Let sDatabaseFile(ByVal New_sDatabaseFile As String)
'    m_sDatabaseFile = New_sDatabaseFile
'    PropertyChanged "sDatabaseFile"
'End Property
'
''注意！不要删除或修改下列被注释的行！
''MemberInfo=13,0,0,0
'Public Property Get sTableName() As String
'    sTableName = m_sTableName
'End Property
'
'Public Property Let sTableName(ByVal New_sTableName As String)
'    m_sTableName = New_sTableName
'    PropertyChanged "sTableName"
'End Property
'
''注意！不要删除或修改下列被注释的行！
''MemberInfo=13,0,0,0
'Public Property Get sDatabasePassword() As String
'    sDatabasePassword = m_sDatabasePassword
'End Property
'
'Public Property Let sDatabasePassword(ByVal New_sDatabasePassword As String)
'    m_sDatabasePassword = New_sDatabasePassword
'    PropertyChanged "sDatabasePassword"
'End Property

'为用户控件初始化属性
Private Sub UserControl_InitProperties()
'    m_sDatabaseFile = m_def_sDatabaseFile
'    m_sTableName = m_def_sTableName
'    m_sDatabasePassword = m_def_sDatabasePassword
    Screen.MousePointer = 11
    m_IsGuest = m_def_IsGuest
    m_sDatabaseFile = m_def_sDatabaseFile
    m_sTableName = m_def_sTableName
    m_sDatabasePassword = m_def_sDatabasePassword
    m_DelSQL1 = m_def_DelSQL1
    m_DelSQL2 = m_def_DelSQL2
    m_DelSQL3 = m_def_DelSQL3
    m_DelSQL4 = m_def_DelSQL4
    m_DelSQL5 = m_def_DelSQL5
    m_UpdateSQL1 = m_def_UpdateSQL1
    m_UpdateSQL2 = m_def_UpdateSQL2
    m_UpdateSQL3 = m_def_UpdateSQL3
    m_UpdateSQL4 = m_def_UpdateSQL4
    m_UpdateSQL5 = m_def_UpdateSQL5
    m_sTypeName = m_def_sTypeName
    AddStore.Caption = "&Addnew" & sTypeName
    StoreDelete.Caption = "&Delete" & sTypeName
    StoreModify.Caption = "&Modify" & sTypeName
    Screen.MousePointer = 0
    
    m_sFieldValue = m_def_sFieldValue
    m_sOldFieldValue = m_def_sOldFieldValue
    m_DelField1 = m_def_DelField1
    m_DelField2 = m_def_DelField2
    m_DelField3 = m_def_DelField3
    m_DelField4 = m_def_DelField4
    m_DelField5 = m_def_DelField5
    m_UpdateField1 = m_def_UpdateField1
    m_UpdateField2 = m_def_UpdateField2
    m_UpdateField3 = m_def_UpdateField3
    m_UpdateField4 = m_def_UpdateField4
    m_UpdateField5 = m_def_UpdateField5
End Sub

'从存贮器中加载属性值
Private Sub UserControl_ReadProperties(PropBag As PropertyBag)

'    m_sDatabaseFile = PropBag.ReadProperty("sDatabaseFile", m_def_sDatabaseFile)
'    m_sTableName = PropBag.ReadProperty("sTableName", m_def_sTableName)
'    m_sDatabasePassword = PropBag.ReadProperty("sDatabasePassword", m_def_sDatabasePassword)
    m_IsGuest = PropBag.ReadProperty("IsGuest", m_def_IsGuest)
        
    m_sDatabaseFile = PropBag.ReadProperty("sDatabaseFile", m_def_sDatabaseFile)
    m_sTableName = PropBag.ReadProperty("sTableName", m_def_sTableName)
    m_sDatabasePassword = PropBag.ReadProperty("sDatabasePassword", m_def_sDatabasePassword)
    m_DelSQL1 = PropBag.ReadProperty("DelSQL1", m_def_DelSQL1)
    m_DelSQL2 = PropBag.ReadProperty("DelSQL2", m_def_DelSQL2)
    m_DelSQL3 = PropBag.ReadProperty("DelSQL3", m_def_DelSQL3)
    m_DelSQL4 = PropBag.ReadProperty("DelSQL4", m_def_DelSQL4)
    m_DelSQL5 = PropBag.ReadProperty("DelSQL5", m_def_DelSQL5)
    m_UpdateSQL1 = PropBag.ReadProperty("UpdateSQL1", m_def_UpdateSQL1)
    m_UpdateSQL2 = PropBag.ReadProperty("UpdateSQL2", m_def_UpdateSQL2)
    m_UpdateSQL3 = PropBag.ReadProperty("UpdateSQL3", m_def_UpdateSQL3)
    m_UpdateSQL4 = PropBag.ReadProperty("UpdateSQL4", m_def_UpdateSQL4)
    m_UpdateSQL5 = PropBag.ReadProperty("UpdateSQL5", m_def_UpdateSQL5)
    m_sTypeName = PropBag.ReadProperty("sTypeName", m_def_sTypeName)
    AddStore.Caption = "添加新" & sTypeName
    StoreDelete.Caption = "删除" & sTypeName
    StoreModify.Caption = "修改" & sTypeName
    
    m_sFieldValue = PropBag.ReadProperty("sFieldValue", m_def_sFieldValue)
    m_sOldFieldValue = PropBag.ReadProperty("sOldFieldValue", m_def_sOldFieldValue)
    m_DelField1 = PropBag.ReadProperty("DelField1", m_def_DelField1)
    m_DelField2 = PropBag.ReadProperty("DelField2", m_def_DelField2)
    m_DelField3 = PropBag.ReadProperty("DelField3", m_def_DelField3)
    m_DelField4 = PropBag.ReadProperty("DelField4", m_def_DelField4)
    m_DelField5 = PropBag.ReadProperty("DelField5", m_def_DelField5)
    m_UpdateField1 = PropBag.ReadProperty("UpdateField1", m_def_UpdateField1)
    m_UpdateField2 = PropBag.ReadProperty("UpdateField2", m_def_UpdateField2)
    m_UpdateField3 = PropBag.ReadProperty("UpdateField3", m_def_UpdateField3)
    m_UpdateField4 = PropBag.ReadProperty("UpdateField4", m_def_UpdateField4)
    m_UpdateField5 = PropBag.ReadProperty("UpdateField5", m_def_UpdateField5)
End Sub