frmemployees_properties.frm

英文版Access数据库编程

   End
   Begin VB.TextBox txtChildren 
      Height          =   285
      Left            =   1440
      Locked          =   -1  'True
      MaxLength       =   2
      TabIndex        =   12
      Text            =   "0"
      Top             =   2640
      Width           =   375
   End
   Begin VB.Label lblHidden 
      Height          =   255
      Left            =   2520
      TabIndex        =   62
      Top             =   120
      Visible         =   0   'False
      Width           =   1215
   End
   Begin VB.Label Label6 
      Caption         =   "Career Progress:"
      Height          =   255
      Left            =   120
      TabIndex        =   60
      Top             =   5880
      Width           =   1455
   End
   Begin VB.Label Label5 
      Caption         =   "Notes:"
      Height          =   255
      Left            =   120
      TabIndex        =   59
      Top             =   4800
      Width           =   1215
   End
   Begin VB.Label Label2 
      Caption         =   "Married:"
      Height          =   255
      Left            =   120
      TabIndex        =   55
      Top             =   2280
      Width           =   1335
   End
   Begin VB.Label Label1 
      Caption         =   "Date of Comm:"
      Height          =   255
      Index           =   17
      Left            =   5160
      TabIndex        =   54
      Top             =   1920
      Width           =   1095
   End
   Begin VB.Label Label1 
      Caption         =   "Salary:"
      Height          =   255
      Index           =   16
      Left            =   5160
      TabIndex        =   53
      Top             =   1560
      Width           =   855
   End
   Begin VB.Label Label1 
      Caption         =   "Position:"
      Height          =   255
      Index           =   15
      Left            =   5160
      TabIndex        =   52
      Top             =   1200
      Width           =   855
   End
   Begin VB.Label Label1 
      Caption         =   "TFN:"
      Height          =   255
      Index           =   14
      Left            =   5160
      TabIndex        =   51
      Top             =   840
      Width           =   855
   End
   Begin VB.Label Label1 
      Caption         =   "Socso:"
      Height          =   255
      Index           =   13
      Left            =   5160
      TabIndex        =   50
      Top             =   480
      Width           =   855
   End
   Begin VB.Label Label1 
      Caption         =   "EPF:"
      Height          =   255
      Index           =   12
      Left            =   5160
      TabIndex        =   49
      Top             =   120
      Width           =   855
   End
   Begin VB.Label Label1 
      Caption         =   "Zip Code:"
      Height          =   255
      Index           =   11
      Left            =   120
      TabIndex        =   48
      Top             =   4440
      Width           =   855
   End
   Begin VB.Label Label1 
      Caption         =   "Country:"
      Height          =   255
      Index           =   10
      Left            =   120
      TabIndex        =   47
      Top             =   3360
      Width           =   855
   End
   Begin VB.Label Label1 
      Caption         =   "State:"
      Height          =   255
      Index           =   9
      Left            =   120
      TabIndex        =   46
      Top             =   3720
      Width           =   855
   End
   Begin VB.Label Label1 
      Caption         =   "City:"
      Height          =   255
      Index           =   8
      Left            =   120
      TabIndex        =   45
      Top             =   4080
      Width           =   855
   End
   Begin VB.Label Label1 
      Caption         =   "Address:"
      Height          =   255
      Index           =   7
      Left            =   120
      TabIndex        =   44
      Top             =   3000
      Width           =   855
   End
   Begin VB.Label Label1 
      Caption         =   "No. of Children:"
      Height          =   255
      Index           =   6
      Left            =   120
      TabIndex        =   43
      Top             =   2640
      Width           =   1215
   End
   Begin VB.Label Label1 
      Caption         =   "Race:"
      Height          =   255
      Index           =   5
      Left            =   120
      TabIndex        =   42
      Top             =   1920
      Width           =   1215
   End
   Begin VB.Label Label1 
      Caption         =   "IC Number:"
      Height          =   255
      Index           =   4
      Left            =   120
      TabIndex        =   41
      Top             =   1560
      Width           =   1215
   End
   Begin VB.Label Label1 
      Caption         =   "Date of Birth:"
      Height          =   255
      Index           =   3
      Left            =   120
      TabIndex        =   40
      Top             =   1200
      Width           =   1215
   End
   Begin VB.Label Label1 
      Caption         =   "Gender:"
      Height          =   255
      Index           =   2
      Left            =   120
      TabIndex        =   39
      Top             =   840
      Width           =   1215
   End
   Begin VB.Label Label1 
      Caption         =   "Name:"
      Height          =   255
      Index           =   1
      Left            =   120
      TabIndex        =   38
      Top             =   480
      Width           =   1215
   End
   Begin VB.Label Label1 
      Caption         =   "Employee ID:"
      Height          =   255
      Index           =   0
      Left            =   120
      TabIndex        =   37
      Top             =   120
      Width           =   1215
   End
End
Attribute VB_Name = "frmEmployees_Properties"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim previousPos As String 'Used to check if the employee has been promoted
Private maxSalary As Single
Private Sub cmbCity_Change()
CheckEmpFields
End Sub

Private Sub cmbCity_GotFocus()
If cmbCity.Text = "[PLEASE SELECT ONE]" Then
    cmbCity.Text = ""
End If
SelText cmbCity
End Sub

Private Sub cmbCity_LostFocus()
CapCon cmbCity
End Sub

Private Sub cmbCountry_Change()
CheckEmpFields
End Sub

Private Sub cmbCountry_Click()
FillComboState cmbState, cmbCountry.Text
End Sub

Private Sub cmbCountry_GotFocus()
If cmbCountry.Text = "[PLEASE SELECT ONE]" Then
    cmbCountry.Text = ""
End If
SelText cmbCountry
End Sub

Private Sub cmbCountry_LostFocus()
CapCon cmbCountry
End Sub

Private Sub cmbPosition_Change()
CheckEmpFields
End Sub

Private Sub cmbPosition_GotFocus()
SelText cmbPosition
End Sub

Private Sub cmbPosition_LostFocus()
CapCon cmbPosition
End Sub

Private Sub cmbRace_Change()
CheckEmpFields
End Sub

Private Sub cmbRace_GotFocus()
If cmbRace.Text = "[PLEASE SELECT ONE]" Then
    cmbRace.Text = ""
End If
SelText cmbRace
End Sub

Private Sub cmbReason_Change()
CheckEmpFields
End Sub

Private Sub cmbReason_GotFocus()
If cmbReason.Text = "[PLEASE SELECT ONE]" Then
    cmbReason.Text = ""
End If
End Sub

Private Sub cmbState_Change()
CheckEmpFields
End Sub

Private Sub cmbState_Click()
FillComboCity cmbCity, cmbState.Text
End Sub

Private Sub cmbState_GotFocus()
If cmbState.Text = "[PLEASE SELECT ONE]" Then
    cmbState.Text = ""
End If
SelText cmbState
End Sub

Private Sub cmbState_LostFocus()
CapCon cmbState
End Sub

Private Sub cmdCancel_Click()
Unload Me
End Sub

Private Sub cmdSave_Click()
'Run validation
If isDateValid(CByte(ddBirth.Text), CByte(mmBirth.Text), CInt(yyyyBirth.Text)) = False Then
    Err.Clear
    ValidMsg "Please enter a valid date of birth.", "Invalid date"
    ddBirth.SetFocus
ElseIf isDateValid(CByte(ddComm.Text), CByte(mmComm.Text), CInt(yyyyComm.Text)) = False Then
    Err.Clear
    ValidMsg "Please enter a valid commencement date.", "Invalid date"
    ddComm.SetFocus
ElseIf (CCur(txtSalary.Text) < 0) Or (CCur(txtSalary.Text) > maxSalary) Then
    Err.Clear
    ValidMsg "Please enter a value between 0 and " & maxSalary & " for salary.", "Invalid salary"
    txtSalary.SetFocus
Else
    If optResignYes.Value = True Then
        If isDateValid(CByte(ddResign.Text), CByte(mmResign.Text), CInt(yyyyResign.Text)) = False Then
            Err.Clear
            ValidMsg "Please enter a valid resignation date.", "Invalid date"
            ddResign.SetFocus
            Exit Sub
        End If
    End If
    
    Dim tempSQL As String
    Dim empRS As Recordset
    On Error GoTo ErrHandler
    tempSQL = "SELECT * FROM Employees WHERE Employees.EmployeeID='" & lblhidden.Caption & "';"
    'On Error GoTo ErrHandler
    Set empRS = MySynonDatabase.OpenRecordset(tempSQL, dbOpenDynaset, dbDenyWrite + dbDenyRead)
    If Not empRS.EOF Then
        empRS.Edit
        empRS("EmployeeID") = txtEmployeeID.Text
        empRS("Name") = txtName.Text
        If optMale.Value = True Then
            empRS("Gender") = False
        Else
            empRS("Gender") = True
        End If
        empRS("DOB") = ddBirth.Text & "/" & mmBirth.Text & "/" & yyyyBirth.Text
        empRS("IC") = txtIC.Text
        empRS("Race") = cmbRace.Text
        If optMarriedYes.Value = True Then
            empRS("Maritial") = True
        Else
            empRS("Maritial") = False
        End If
            empRS("Children") = txtChildren.Text
        empRS("Address") = txtAddress.Text
        empRS("CountryID") = cmbCountry.Text
        empRS("StateID") = cmbState.Text
        empRS("City") = cmbCity.Text
        empRS("Zip") = txtZip.Text
        empRS("SSN") = txtSocso.Text
        empRS("EPF") = txtEPF.Text
        empRS("TFN") = txtTFN.Text
        empRS("PositionID") = cmbPosition.Text
        empRS("Salary") = txtSalary.Text
        empRS("Commence") = ddComm.Text & "/" & mmComm.Text & "/" & yyyyComm.Text
        If optResignYes.Value = True Then
            empRS("Resign") = True
            empRS("Resignation") = ddResign.Text & "/" & mmResign.Text & "/" & yyyyResign.Text
            empRS("Reason") = cmbReason.Text
        Else
            empRS("Resign") = False
        End If
        BeginTrans
        empRS.Update
        CommitTrans
        empRS.Close
        If cmbPosition.Text <> previousPos Then
            tempSQL = "INSERT INTO Progress VALUES ('" & txtEmployeeID.Text & "','" & Format$(Now(), "dd/mm/yyyy") & "','Promoted from " & _
            previousPos & " to the position of a " & cmbPosition.Text & ".');"
            MySynonDatabase.Execute tempSQL
        End If
        InfoMsg "Employee details have been successfully updated.", "Record saved"
        Set empRS = Nothing
        Unload Me
    End If
End If

ErrHandler:
If Err.Number <> 0 Then
    Rollback
    ErrorNotifier Err.Number, Err.description
End If
End Sub

Private Sub ddBirth_Click()
CheckEmpFields
End Sub

Private Sub ddBirth_GotFocus()
SelText ddBirth
End Sub

Private Sub ddBirth_KeyPress(KeyAscii As Integer)
OnlyNum KeyAscii
End Sub

Private Sub ddComm_Click()
CheckEmpFields
End Sub

Private Sub ddComm_GotFocus()
SelText ddComm
End Sub

Private Sub ddComm_KeyPress(KeyAscii As Integer)
OnlyNum KeyAscii
End Sub

Private Sub ddComm_LostFocus()
If Len(ddComm.Text) > 0 Then
    ddComm.Text = Format(ddComm.Text, "00")
End If