frmmemberadd.frm

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

         Caption         =   "添 加 新 的 员 工"
         ForeColor       =   &H00FFFFFF&
         Height          =   210
         Index           =   1
         Left            =   2955
         TabIndex        =   41
         Top             =   225
         Width           =   1785
      End
      Begin VB.Label Label1 
         AutoSize        =   -1  'True
         BackStyle       =   0  'Transparent
         Caption         =   "添 加 新 的 员 工"
         ForeColor       =   &H00000000&
         Height          =   210
         Index           =   0
         Left            =   2970
         TabIndex        =   21
         Top             =   255
         Width           =   1785
      End
   End
End
Attribute VB_Name = "frmMemberAdd"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Public AddTrue As Boolean   '添加为真时

Private Sub cmbCheck_Change()

  'AddTrue = True
  
End Sub

Private Sub cmbCheck_Click()

  'AddTrue = True
  'ftGuest(12).Text = cmbCheck.ListIndex
    
End Sub

Private Sub cmdCancel_Click()

   Unload Me
  
End Sub

Private Sub cmdClear_Click()

  ftGuest(7).Text = ""
  
End Sub

Private Sub cmdSave_Click()

 '保存员工资料
  On Error GoTo LoadERR
  
  If ftGuest(0).Text = "" Then
     MsgBox "请输入员工编号,不能重复?  ", vbInformation
     ftGuest(0).SetFocus
     Exit Sub
  End If
  If ftGuest(1).Text = "" Then
     MsgBox "请输入员工名称,最好不要重复? ", vbInformation
     ftGuest(1).SetFocus
     Exit Sub
  End If
 
      
 '检查该员工编号是否存在
  Dim DB As Connection
  Dim Rs As Recordset
  Dim sTmp As String
  Dim intTmp As Integer
      intTmp = 0
      
  Set DB = CreateObject("adodb.connection")
  Set Rs = CreateObject("adodb.recordset")
      DB.Open Constr
      DB.BeginTrans
      
     '修改现金库中的押金额及现金额
      sTmp = "Select * from tbdGuest WHere Dguest='" & Trim(ftGuest(0).Text) & "'"
      Rs.Open sTmp, DB, adOpenStatic, adLockOptimistic, adCmdText
    
      Dim CashRec As Recordset, CashAmount As Recordset
             
      If Not (Rs.EOF And Rs.BOF) Then
            
            Rs.Close
            Set Rs = Nothing
            DB.RollbackTrans
            DB.Close
            Set DB = Nothing
            
            MsgBox Trim(ftGuest(0).Text) & "编号已经存在,,修改编号后继续?  ", vbExclamation
            ftGuest(0).SetFocus
            Exit Sub
         
      Else
        '添加新员工
         Rs.AddNew
         For intTmp = 0 To 7
             If Trim(ftGuest(intTmp).Text) <> "" Then
                Select Case intTmp
                Case 6
                  Rs.Fields("DEmail") = ftGuest(intTmp).Text
                Case 7
                  Rs.Fields("DStr") = ftGuest(intTmp).Text
                Case Else
                  Rs.Fields(intTmp) = ftGuest(intTmp).Text
                End Select
             End If
         Next
         If Trim(ftMemo.Text) <> "" Then
            Rs.Fields("DMemo") = ftMemo.Text
         End If
         Rs.Update
      End If
      
  '插入到现金流水帐中
   If CCur(ftGuest(5).Text) <> 0 Then
      InserToCash DB, 1, "员工【" & ftGuest(1).Text & "】交纳的押金", CCur(ftGuest(5).Text), Date, "现金"
   End If
   
   SaveNewNo "员工总数", DB
   
   Rs.Close
   Set Rs = Nothing
   DB.CommitTrans
   DB.Close
   Set DB = Nothing
 
   ResetAddForm
   AddTrue = False
   IsChangeIT = True
   
   Exit Sub
LoadERR:
   On Error Resume Next
   DB.Close
   Set DB = Nothing
   MsgBox "保存员工数据错误:" & Err.Description & vbCrLf & vbCrLf & "请输入更多信息,才能保存。  ", vbCritical
   Exit Sub
   
End Sub

Private Sub cmdScan_Click()
 
  On Error Resume Next
  
  ScanFileName = ""
  Me.MousePointer = 11
  
  frmScan.Show 1
  
  Me.MousePointer = 0
  If ScanFileName <> "" Then
     ftGuest(7).Text = ScanFileName
     imgView.Picture = LoadPicture(ScanFileName)
    Else
     ftGuest(7).SetFocus
  End If
  
End Sub

Private Sub cmdSelect_Click()

  On Error Resume Next
  
  dlgAccess.CancelError = True
  dlgAccess.DialogTitle = "选择图片文件"
  dlgAccess.Filter = "所有图片文件|*.bmp;*.jpg;*.gif"
  dlgAccess.Flags = cdlOFNFileMustExist + cdlOFNHideReadOnly
  dlgAccess.ShowOpen
  
  If Err.Number = 32755 Then
     '用户取消时
      ftGuest(7).SetFocus
      Exit Sub
    Else
      ftGuest(7).Text = dlgAccess.FileName
      imgView.Picture = LoadPicture(dlgAccess.FileName)
  End If

End Sub

'Private Sub cmdType_Click()

  '显示员工管理
'   frmMemberLevel.Show 1
  
'End Sub

Private Sub Form_Load()

   GetFormSet Me, Screen
   
   'Dim intTmp As Integer
     '  intTmp = GetSetting(App.EXEName, "SET", "DEDUCT", 0)
     '缺省员工为每次扣除
     ' cmbCheck.ListIndex = intTmp
     ' cmbType.ListIndex = 0
     'ftExpireDate.Value = Date
     '缺省为一个月以后过期
     'ftGuest(11).Text = Date
     
   ResetAddForm
   
   AddTrue = False
      
End Sub

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)

  On Error Resume Next
  Dim intTmp As Integer
  
  If AddTrue = True Then
     intTmp = MsgBox("您已经修改部份数据,尚未保存？ " & vbCrLf & "按[是]保存退出,按[否]返回。  ", vbYesNoCancel + vbInformation)
     If intTmp = vbCancel Then
        Cancel = -1
        Exit Sub
     End If
     If intTmp = vbYes Then
        Call cmdSave_Click
        Exit Sub
     End If
     If intTmp = vbNo Then
        Exit Sub
     End If
  End If
  
End Sub

Private Sub Form_Resize()

   On Error Resume Next
   
   If Me.WindowState = 1 Then Exit Sub
   
      Me.Width = 7905
      Me.Height = 6465
      
End Sub

Private Sub Form_Unload(Cancel As Integer)

   SaveFormSet Me
   'SaveSetting App.EXEName, "SET", "DEDUCT", cmbCheck.ListIndex
   
End Sub

Private Sub ftExpireDate_Change()

  'ftGuest(11).Text = ftExpireDate.Value
  
End Sub

Private Sub ftGuest_Change(Index As Integer)

  On Error Resume Next
  
  AddTrue = True
  
  Select Case Index
    Case 5
        If ftGuest(5).Text = "" Then
           ftGuest(5).Text = "0"
           ftGuest(5).SelStart = 0
           ftGuest(5).SelLength = 1
           Exit Sub
        End If
   Case 7
        If ftGuest(7).Text = "" Then
          '清空图片框
           imgView.Picture = LoadPicture()
           Exit Sub
        End If
 End Select
 
End Sub

Private Sub ftGuest_KeyDown(Index As Integer, KeyCode As Integer, Shift As Integer)

  On Error Resume Next
  
  Select Case KeyCode
         Case 13
          If Index >= 0 And Index < 7 Then
             ftGuest(Index + 1).SetFocus
             Exit Sub
          End If
         Case 38
          If Index >= 1 And Index <= 7 Then
             ftGuest(Index - 1).SetFocus
             Exit Sub
          End If
         Case 0
         '向下
          If Index >= 0 And Index < 7 Then
             ftGuest(Index + 1).SetFocus
             Exit Sub
          End If
  End Select
  
End Sub

Private Sub ResetAddForm()

   On Error Resume Next
   
   ftGuest(0).Text = GetNewNo("员工总数")
   ftGuest(1).Text = ""
   ftGuest(2).Text = ""
   ftGuest(3).Text = ""
   ftGuest(4).Text = ""
   ftGuest(7).Text = ""
   
   ftGuest(5).Text = "0"
   ftGuest(6).Text = ""
   'ftGuest(8).Text = "0"
   'ftGuest(9).Text = "0"
   'ftGuest(10).Text = "0"
  
  '缺省为一个月以后过期
   'ftGuest(11).Text = Date
   'cmbType.ListIndex = 0
   
   ftGuest(0).SetFocus
   
End Sub