salarysurvey.ebf

< 嵌入式系统编程源代码解析>>这本书所附的代码,有了几个典型的实例,但有些看不懂,不知它是基于什么的,不好入手搞.

            Display
            DisableFields
        Else
            MsgBox "NO Record Deleted"
            RSSalaryModify.Close
            Set RSSalaryModify = Nothing
        End If
    Else
        MsgBox "NO Record to Delete"
        RSSalaryModify.Close
        Set RSSalaryModify = Nothing
    End If
End Sub
' This control event is to display the first record
Private Sub cmdFirst_Click()
    cmdSave.Enabled = False
    ClearAllFields
    RSSalary.MoveFirst
    Display
End Sub
' this control event is to display the last record
Private Sub cmdLast_Click()
    cmdSave.Enabled = False
    ClearAllFields
    RSSalary.MoveLast
    Display
End Sub
' This control event is to get the record to be modified
Private Sub cmdModify_Click()
    EnableFields
    txtID.SetFocus
    MyQuery = "SELECT * FROM SalarySurvey where ID='" & txtID.Text & "'"
    Set RSSalaryModify = CreateObject("ADOCE.Recordset.3.0")
    RSSalaryModify.Open MyQuery, CNSalary, adOpenKeyset, adLockOptimistic
    If RSSalaryModify.RecordCount > 0 Then
        ModifyID = RSSalaryModify.Fields("ID")
        DisablecmdButtons
        cmdClose.Caption = "Cancel"
        MyButtonAction = "Modify"
        RSSalaryModify.Close
        Set RSSalaryModify = Nothing
    Else
        MsgBox "NO Record"
        RSSalaryModify.Close
        Set RSSalaryModify = Nothing
    End If
    
End Sub
'This control event is to display the next record
Private Sub cmdNext_Click()
    cmdSave.Enabled = False
    ClearAllFields
    If RSSalary.Bookmark = MyLastBookMark Then
        RSSalary.MoveLast
        MsgBox "Last Record"
    Else
        RSSalary.MoveNext
    End If
    Display
End Sub
'This control event is to display the previous record
Private Sub cmdPrevious_Click()
    cmdSave.Enabled = False
    ClearAllFields
    If RSSalary.Bookmark = MyFirstBookMark Then
        RSSalary.MoveFirst
        MsgBox "First Record"
    Else
        RSSalary.MovePrevious
    End If
    Display
End Sub

'This control event is to add new record or update existing record
Private Sub cmdSave_Click()
    If MyButtonAction = "New" Then
        MyQuery = "SELECT * FROM SalarySurvey where ID='" & txtID.Text & "'"
        Set RSSalarySave = CreateObject("ADOCE.Recordset.3.0")
        RSSalarySave.Open MyQuery, CNSalary, adOpenKeyset, adLockOptimistic
        If RSSalarySave.RecordCount > 0 Then
            MsgBox "With This Id Record Already Exists"
            RSSalarySave.Close
            Set RSSalarySave = Nothing
        Else
            RSSalarySave.AddNew
            AddDataFromFieldsToDB
            RSSalarySave.Update
            RSSalarySave.Close
            Set RSSalarySave = Nothing
            EnablecmdButtons
            cmdClose.Caption = "Exit"
            MyButtonAction = ""
            RefreshDB
            RSSalary.MoveFirst
            ClearAllFields
            Display
            DisableFields
        End If
    ElseIf MyButtonAction = "Modify" Then
        MyQuery = "SELECT * FROM SalarySurvey where ID='" & txtID.Text & "'"
        Set RSSalaryModify = CreateObject("ADOCE.Recordset.3.0")
        RSSalaryModify.Open MyQuery, CNSalary, adOpenKeyset, adLockOptimistic
        If RSSalaryModify.RecordCount > 0 Then
            If CInt(Trim(txtID.Text)) = ModifyID Then
                MyQueryModify = "SELECT * FROM SalarySurvey where ID='" & ModifyID & "'"
                Set RSSalarySave = CreateObject("ADOCE.Recordset.3.0")
                RSSalarySave.Open MyQueryModify, CNSalary, adOpenKeyset, adLockOptimistic
                If RSSalarySave.RecordCount > 0 Then
                    AddDataFromFieldsToDB
                    RSSalarySave.Update
                    RSSalarySave.Close
                    Set RSSalarySave = Nothing
                    EnablecmdButtons
                    cmdClose.Caption = "Exit"
                    MyButtonAction = ""
                    MyCurrentBookMark = RSSalary.Bookmark
                    RefreshDB
                    RSSalary.Bookmark = MyCurrentBookMark
                    DisableFields
                End If
                RSSalaryModify.Close
                Set RSSalaryModify = Nothing

            Else
                MsgBox "With This Id Record Already Exists"
                RSSalaryModify.Close
                Set RSSalaryModify = Nothing
            End If
            
        Else
            
            MyQueryModify = "SELECT * FROM SalarySurvey where ID='" & ModifyID & "'"
            Set RSSalarySave = CreateObject("ADOCE.Recordset.3.0")
            RSSalarySave.Open MyQueryModify, CNSalary, adOpenKeyset, adLockOptimistic
            If RSSalarySave.RecordCount > 0 Then
                AddDataFromFieldsToDB
                RSSalarySave.Update
                RSSalarySave.Close
                Set RSSalarySave = Nothing
                EnablecmdButtons
                cmdClose.Caption = "Exit"
                MyButtonAction = ""
                MyCurrentBookMark = RSSalary.Bookmark
                RefreshDB
                RSSalary.Bookmark = MyCurrentBookMark
                DisableFields
            End If
            RSSalaryModify.Close
            Set RSSalaryModify = Nothing
        End If

    End If
End Sub
'This form event is to display first record data while the application is loading.
Private Sub Form_Load()
    'CreateDBandTable
    Set CNSalary = CreateObject("ADOCE.Connection.3.0")
    CNSalary.Open "\My Documents\Salary\SalaryDB.cdb"
    EnablecmdButtons
    ClearAllFields
    MyQuery = "SELECT * FROM SalarySurvey"
    Set RSSalary = CreateObject("ADOCE.Recordset.3.0")
    RSSalary.Open MyQuery, CNSalary, adOpenKeyset, adLockOptimistic
    If RSSalary.RecordCount > 0 Then
        RSSalary.MoveFirst
        MyFirstBookMark = RSSalary.Bookmark
        RSSalary.MoveLast
        MyLastBookMark = RSSalary.Bookmark
        RSSalary.MoveFirst
        Display
    Else
         MsgBox "No Records In the Database"
    End If
    DisableFields
End Sub
'This control event is to close the record set, connection and application
Private Sub Form_OKClick()
   RSSalary.Close
   Set RSSalary = Nothing
   CNSalary.Close
   Set CNSalary = Nothing
   App.End
End Sub
'This procedure is to clear all the text boxes
Private Sub ClearAllFields()
    txtID.Text = ""
    txtDesignation.Text = ""
    txtOrgType.Text = ""
    txtAnualSalary.Text = ""
    txtServiceinOrg.Text = ""
    txttotalService.Text = ""
End Sub
'This procedure is to assigning database fields data to text fields
Private Sub Display()
    txtID.Text = RSSalary.Fields("ID")
    txtDesignation.Text = RSSalary.Fields("Designation")
    txtOrgType.Text = RSSalary.Fields("TypeOfOrg")
    txtAnualSalary.Text = RSSalary.Fields("Salary")
    txtServiceinOrg.Text = RSSalary.Fields("ServiceOfOrg")
    txttotalService.Text = RSSalary.Fields("TotalService")
End Sub
'This procedure is to create database and tables
Private Sub CreateDBandTable()
    Dim SQl As String
    Set RSSalary = CreateObject("ADOCE.Recordset.3.0")
    ' create database
    RSSalary.Open "CREATE DATABASE '\My Documents\Salary\SalaryDB.cdb'"
    ' create SalarySurvey Table
    SQl = "CREATE TABLE SalarySurvey ("
    SQl = SQl & "ID int ,"
    SQl = SQl & "Designation varchar(30) ,"
    SQl = SQl & "TypeOfOrg varchar(30) ,"
    SQl = SQl & "Salary varchar(10) ,"
    SQl = SQl & "ServiceOfOrg int ,"
    SQl = SQl & "TotalService int )"
    RSSalary.Open SQl, "\My Documents\Salary\SalaryDB.cdb"
    'Create Index for SalarySurvey Table
    RSSalary.Open "CREATE INDEX PrimaryKey ON SalarySurvey(ID)", _
    "\My Documents\Salary\SalaryDB.cdb"
    RSSalary.Close
    Set RSSalary = Nothing

End Sub
'This procedure is to disable all text fields
Private Sub DisableFields()
    txtID.Enabled = False
    txtDesignation.Enabled = False
    txtOrgType.Enabled = False
    txtAnualSalary.Enabled = False
    txtServiceinOrg.Enabled = False
    txttotalService.Enabled = False
End Sub
'This procedure is to enable all text fields
Private Sub EnableFields()
    txtID.Enabled = True
    txtDesignation.Enabled = True
    txtOrgType.Enabled = True
    txtAnualSalary.Enabled = True
    txtServiceinOrg.Enabled = True
    txttotalService.Enabled = True
End Sub
'This procedure is to enable the command buttons
Private Sub EnablecmdButtons()
    cmdSave.Enabled = False
    cmdADD.Enabled = True
    cmdModify.Enabled = True
    cmdDelete.Enabled = True
    cmdFirst.Enabled = True
    cmdLast.Enabled = True
    cmdNext.Enabled = True
    cmdPrevious.Enabled = True
End Sub
'This procedure is to disable the command buttons
Private Sub DisablecmdButtons()
    cmdSave.Enabled = True
    cmdADD.Enabled = False
    cmdModify.Enabled = False
    cmdDelete.Enabled = False
    cmdFirst.Enabled = False
    cmdLast.Enabled = False
    cmdNext.Enabled = False
    cmdPrevious.Enabled = False
End Sub
'This procedure is to read data from text fields and add to database
Private Sub AddDataFromFieldsToDB()
    RSSalarySave.Fields("ID") = Trim(txtID.Text)
    RSSalarySave.Fields("Designation") = Trim(txtDesignation.Text)
    RSSalarySave.Fields("TypeOfOrg") = Trim(txtOrgType.Text)
    RSSalarySave.Fields("Salary") = Trim(txtAnualSalary.Text)
    RSSalarySave.Fields("ServiceOfOrg") = Trim(txtServiceinOrg.Text)
    RSSalarySave.Fields("TotalService") = Trim(txttotalService.Text)
End Sub
'This procedure is to refresh the database
Private Sub RefreshDB()
    RSSalary.Close
    Set RSSalary = Nothing
    MyQuery = "SELECT * FROM SalarySurvey"
    Set RSSalary = CreateObject("ADOCE.Recordset.3.0")
    RSSalary.Open MyQuery, CNSalary, adOpenKeyset, adLockOptimistic
    RSSalary.MoveFirst
    MyFirstBookMark = RSSalary.Bookmark
    RSSalary.MoveLast
    MyLastBookMark = RSSalary.Bookmark
End Sub
' This event is to validate for null.
Private Sub txtAnnualSalary_LostFocus()
    If txtAnnualSalary.Text = "" Then
        MsgBox "This field is manditory"
        txtAnnualSalary.SetFocus
    End If
End Sub
' This event is to validate for null.
Private Sub txtDesignation_LostFocus()
    If txtDesignation.Text = "" Then
        MsgBox "This field is manditory"
        txtDesignation.SetFocus
    End If
End Sub
' This event is to validate for null
Private Sub txtID_LostFocus()
    If txtID.Text = "" Then
        MsgBox "This field is manditory"
        txtID.SetFocus
    End If
End Sub
' This event is to validate for null
Private Sub txtTotalService_LostFocus()
    If txttotalService.Text = "" Then
        MsgBox "This field is manditory"
        txttotalService.SetFocus
    End If
End Sub
' This event is to validate for null.
Private Sub txtOrgType_LostFocus()
    If txtOrgType.Text = "" Then
        MsgBox "This field is manditory"
        txtOrgType.SetFocus
    End If
End Sub
' This event is to validate for null.
Private Sub txtServiceinOrg_LostFocus()
    If txtServiceinOrg.Text = "" Then
        MsgBox "This field is manditory"
        txtServiceinOrg.SetFocus
    End If
End Sub
' This event is to validate for numeric values
Private Sub txtID_KeyPress(ByVal KeyAscii As Integer)
    If KeyAscii = 8 Or KeyAscii >= 48 And KeyAscii <= 57 Then
    Else
        KeyAscii = 0
        MsgBox "Enter Numbers only"
    End If
End Sub
' This event is to validate for numeric values
Private Sub txtAnnualSalary_KeyPress(ByVal KeyAscii As Integer)
    If KeyAscii = 8 Or KeyAscii = 46 Or KeyAscii >= 48 And KeyAscii <= 57 Then
    Else
        KeyAscii = 0
        MsgBox "Enter Numbers only"
    End If
End Sub
' This event is to validate for numeric values
Private Sub txtServiceinOrg_KeyPress(ByVal KeyAscii As Integer)
    If KeyAscii = 8 Or KeyAscii >= 48 And KeyAscii <= 57 Then
    Else
        KeyAscii = 0
        MsgBox "Enter Numbers only"
    End If
End Sub
' This event is to validate for numeric values
Private Sub txtTotalService_KeyPress(ByVal KeyAscii As Integer)
    If KeyAscii = 8 Or KeyAscii >= 48 And KeyAscii <= 57 Then
    Else
        KeyAscii = 0
        MsgBox "Enter Numbers only"
    End If
End Sub