frmemploy.frm

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

  RefreshGuestGrid " Order By DGuest"

End Sub

Private Sub cmdClose_Click()

  Unload Me
  
End Sub

Private Sub cmdDel_Click()

  On Error GoTo DelERR
  
 '为0时退出
  If lvwList.ListItems.Count = 0 Then Exit Sub
 '没有选择时退出
  If lvwList.SelectedItem.Text = "" Then Exit Sub
  
  mnuGuestDel_Click
  
  Exit Sub
DelERR:
  MsgBox "删除员工错误:" & Err.Description, vbCritical
  Exit Sub

End Sub

Private Sub cmdNew_Click()
  
  IsChangeIT = False
  frmMemberAdd.Show 1
    
  If IsChangeIT = True Then
    '刷新员工信息
     RefreshGuestGrid " Order By DGuest"
  End If

End Sub

Private Sub cmdPrint_Click()

 '为0时退出
  If lvwList.ListItems.Count = 0 Then Exit Sub
 
 '打印列表
  If MsgBox("真的要打印员工列表吗？(Y/N)   " & vbCrLf _
     & "请设置打印：A4纸 纵向   " & vbCrLf & "如果你需要打印部分员工,请首先查询然后打印。  ", vbInformation + vbYesNo, "www.vb-code.net") = vbNo Then
     Exit Sub
  End If
 
Dim ptGrid As listViewPrint
 
'建立打印对象
On Error GoTo Err1

Set ptGrid = New listViewPrint
    ptGrid.N_Border = 1
    ptGrid.N_Cols = "1,2,3,4,5,6"
    Set ptGrid.N_Grid = lvwList
    ptGrid.N_TiTle = "【员工列表】"
    ptGrid.N_Head10 = "制表人：" & strUserName
    ptGrid.N_Head2 = "制表时间：" & Now
    ptGrid.N_PageLeft = XLeft
    ptGrid.N_PageHeight = 290
    ptGrid.N_PageWidth = 200
    ptGrid.N_PageTop = XTop
    ptGrid.N_RowHeight = 6
    ptGrid.PrintPage
    
    Set ptGrid = Nothing
  
 Exit Sub
Err1:
  MsgBox "对不起,打印列表错误。  " & vbCrLf & vbCrLf & Err.Description, vbInformation
  Exit Sub

End Sub

Private Sub cmdSearch_Click()

  IsChangeIT = False
  strSearch = ""
  
  frmMemberFind.Show 1
  
  If IsChangeIT = True Then
     '刷新列表
      RefreshGuestGrid strSearch & " Order By DGuest"
  End If

End Sub

Private Sub Command1_Click()

  On Error GoTo ModifyERR
  
 '为0时退出
  If lvwList.ListItems.Count = 0 Then Exit Sub
 '没有选择时退出
  If lvwList.SelectedItem.Text = "" Then Exit Sub
  
  frmMemberEdit.sOldID = lvwList.SelectedItem.Text
  frmMemberEdit.Show 1
  
  Exit Sub
ModifyERR:
  MsgBox "对不起,修改错误:" & Err.Description & vbCrLf & "请输入更多信息,才能保存。  ", vbCritical
  Exit Sub

End Sub

Private Sub Form_Activate()
  
  frmMain.lbControl.Caption = "员工管理"

End Sub

Private Sub Form_Load()

  GetFormSet Me, frmMain
  EmployFocus = True
 
 '刷新列表,显示员工
  RefreshGuestGrid strSearch & " Order By DGuest"
  
End Sub

Private Sub Form_Resize()

  If Me.WindowState = 1 Then Exit Sub
        
 '常规时
  If Me.WindowState = 0 Then
     Me.Move 1, 1, frmMain.Width - (frmMain.picTool.Width + 200), frmMain.Height - (frmMain.picADV.Height + 1150)
  End If
  
  Frame1.Width = Me.ScaleWidth - 100
  Frame1.Height = Me.ScaleHeight - 100
  lvwList.Left = 60
  lvwList.Top = 600
  lvwList.Width = Frame1.Width - 120
  lvwList.Height = Frame1.Height - 680
  cmdClose.Left = Frame1.Width - cmdClose.Width - 100
  
End Sub

Private Sub Form_Unload(Cancel As Integer)

  frmMain.lbControl.Caption = "收银控制中心"
  EmployFocus = False
  SaveFormSet Me
  
End Sub

'排序
Private Sub lvwList_ColumnClick(ByVal ColumnHeader As MSComctlLib.ColumnHeader)

  On Error Resume Next
  
  If lvwList.ListItems.Count > 0 Then
 
    lvwList.SortKey = ColumnHeader.Index - 1
    lvwList.Sorted = True
    
    If lvwList.SortOrder = lvwAscending Then
       lvwList.SortOrder = lvwDescending
       Else
       lvwList.SortOrder = lvwAscending
    End If
    
 End If

End Sub

Private Sub lvwList_DblClick()

  '调用查看
   mnuViewmember_Click
   
End Sub

Private Sub lvwList_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)

  If Button = 2 Then
     PopupMenu mnuMember
  End If
  
End Sub

'给出员工信息
Private Sub RefreshGuestGrid(sOrder As String)

 On Error GoTo LoadERR

 Dim DB As Connection
 Dim EF As Recordset
 Dim tmpLT As ListItem
 
 Set DB = CreateObject("ADODB.Connection")
     DB.Open Constr
 Set EF = CreateObject("ADODB.Recordset")
     EF.Open "Select * from tbdGuest " & sOrder, DB, adOpenForwardOnly, adLockReadOnly, adCmdText
     
     lvwList.Visible = False
     lvwList.ListItems.Clear
     DoEvents
     
     If Not (EF.EOF And EF.BOF) Then
        Do While Not EF.EOF
           '插入到员工列表中
            InsertToGuestList lvwList, tmpLT, EF.Fields("DGuest"), EF.Fields("DName"), _
             NullValue(EF.Fields("DAddress")), NullValue(EF.Fields("DTel")), NullValue(EF.Fields("DIcq")), NullValue(EF.Fields("DEmail"))
            DoEvents
            EF.MoveNext
         Loop
    End If
 
'显示员工列表
 lvwList.Visible = True
 
 EF.Close
 DB.Close
 
 Exit Sub
LoadERR:
  lvwList.View = t
  MsgBox "安装员工列表出错？" & Err.Description, vbExclamation, "www.vb-code.net"""
  Exit Sub
   
End Sub

Private Sub InsertToGuestList(tmpView As ListView, tmpItem As ListItem, sText1 As String, sText2 As String, sText3 As String _
      , sText4 As String, sText5 As String, sText6 As String)
 
   On Error Resume Next
     
   Set tmpItem = tmpView.ListItems.Add
       tmpItem.Text = Trim(sText1)
       tmpItem.SubItems(1) = Trim(sText2)
       tmpItem.SubItems(2) = Trim(sText3)
       tmpItem.SubItems(3) = Trim(sText4)
       tmpItem.SubItems(4) = Trim(sText5)
       tmpItem.SubItems(5) = Trim(sText6)
       
End Sub

Private Sub mnuAllMember_Click()

  cmdAll_Click

End Sub

Private Sub mnuDeletemember_Click()

   cmdDel_Click

End Sub

Private Sub mnuFIndMember_Click()

   cmdSearch_Click

End Sub

Private Sub mnuModifyMember_Click()

  Command1_Click

End Sub

Private Sub mnuNewMember_Click()

  cmdNew_Click

End Sub

Private Sub mnuPrintmember_Click()

  cmdPrint_Click

End Sub

Private Sub mnuViewmember_Click()

  On Error GoTo ModifyERR
  
 '为0时退出
  If lvwList.ListItems.Count = 0 Then Exit Sub
 '没有选择时退出
  If lvwList.SelectedItem.Text = "" Then Exit Sub
  
  frmMemberView.sOldID = lvwList.SelectedItem.Text
  frmMemberView.Show 1
  
  Exit Sub
ModifyERR:
  MsgBox "不能查看员工资料:" & Err.Description, vbCritical
  Exit Sub


End Sub

Private Sub mnuGuestDel_Click()

   On Error GoTo DelERR
   
  '删除员工信息
   Dim stmpID As String
       stmpID = Trim(lvwList.SelectedItem.Text)
       
   If stmpID = "" Then Exit Sub
   
   If MsgBox("真的要删除编号[" & stmpID & "]员工吗? ", vbYesNo + vbInformation) = vbNo Then Exit Sub
   
  '删除动作
   Dim DB As Connection
   Set DB = CreateObject("adodb.connection")
       DB.Open Constr
       DB.BeginTrans
   Dim sTmp As String
       sTmp = "Delete from tbdGuest Where DGuest='" & stmpID & "'"
       DB.Execute sTmp
   DB.CommitTrans
   DB.Close
   Set DB = Nothing
    
  '移走
   lvwList.ListItems.Remove (lvwList.SelectedItem.Index)
    
   Exit Sub
DelERR:
   MsgBox "删除员工错误:" & Err.Description, vbExclamation
   Exit Sub
   
End Sub