Visual Basic Source Code/Visual Basic Source Code.iso/vbsource/dataex/datasamp.frm

Visual Basic Form | 1995-05-07 | 11.2 KB | 383 lines

VERSION 2.00
Begin Form Form1
   Caption         =   "Data Control Example"
   ClientHeight    =   4155
   ClientLeft      =   1095
   ClientTop       =   1575
   ClientWidth     =   7020
   Height          =   4560
   Left            =   1035
   LinkTopic       =   "Form1"
   ScaleHeight     =   4155
   ScaleWidth      =   7020
   Top             =   1230
   Width           =   7140
   Begin TextBox Text1
      DataField       =   "bitfield"
      DataSource      =   "data1"
      Height          =   285
      Left            =   2400
      TabIndex        =   18
      Top             =   360
      Width           =   1215
   End
   Begin CommandButton cmdGrid
      Caption         =   "Show Grid"
      Height          =   375
      Left            =   4200
      TabIndex        =   17
      Top             =   3720
      Width           =   1095
   End
   Begin CommandButton cmdEnd
      Caption         =   "End"
      Height          =   375
      Left            =   5640
      TabIndex        =   16
      Top             =   2520
      Width           =   1095
   End
   Begin TextBox txtID
      DataField       =   "scount"
      DataSource      =   "Data1"
      Enabled         =   0   'False
      Height          =   285
      Left            =   600
      TabIndex        =   0
      Top             =   360
      Width           =   1335
   End
   Begin CommandButton cmdDelete
      Caption         =   "Delete"
      Height          =   375
      Left            =   4200
      TabIndex        =   12
      Top             =   1320
      Width           =   1095
   End
   Begin CommandButton cmdCancel
      Caption         =   "Cancel"
      Height          =   375
      Left            =   4200
      TabIndex        =   11
      Top             =   3120
      Width           =   1095
   End
   Begin CommandButton cmdSave
      Caption         =   "Save"
      Height          =   375
      Left            =   4200
      TabIndex        =   10
      Top             =   2520
      Width           =   1095
   End
   Begin CommandButton cmdAdd
      Caption         =   "Add"
      Height          =   375
      Left            =   4200
      TabIndex        =   9
      Top             =   1920
      Width           =   1095
   End
   Begin CommandButton cmdUpdate
      Caption         =   "Update"
      Enabled         =   0   'False
      Height          =   375
      Left            =   4200
      TabIndex        =   8
      Top             =   720
      Width           =   1100
   End
   Begin CommandButton cmdFind
      Caption         =   "Find"
      Height          =   375
      Left            =   4200
      TabIndex        =   7
      Top             =   120
      Width           =   1100
   End
   Begin CommandButton cmdLast
      Caption         =   "Last"
      Height          =   375
      Left            =   5640
      TabIndex        =   6
      Top             =   1920
      Width           =   1100
   End
   Begin CommandButton cmdFirst
      Caption         =   "First"
      Height          =   375
      Left            =   5640
      TabIndex        =   5
      Top             =   1320
      Width           =   1100
   End
   Begin CommandButton cmdPrior
      Caption         =   "Prior"
      Height          =   375
      Left            =   5640
      TabIndex        =   4
      Top             =   720
      Width           =   1100
   End
   Begin CommandButton cmdNext
      Caption         =   "Next"
      Height          =   375
      Left            =   5640
      TabIndex        =   3
      Top             =   120
      Width           =   1100
   End
   Begin TextBox txtFirstName
      DataField       =   "class"
      DataSource      =   "Data1"
      Height          =   375
      Left            =   600
      TabIndex        =   2
      Top             =   1920
      Width           =   3135
   End
   Begin TextBox txtLastName
      DataField       =   "name"
      DataSource      =   "Data1"
      Height          =   375
      Left            =   600
      TabIndex        =   1
      Top             =   1080
      Width           =   3135
   End
   Begin Data Data1
      Caption         =   "Data1"
      Connect         =   ""
      DatabaseName    =   "asample.MDB"
      Exclusive       =   0   'False
      Height          =   270
      Left            =   600
      Options         =   0
      ReadOnly        =   0   'False
      RecordSource    =   "student"
      Top             =   2640
      Width           =   3135
   End
   Begin Label Label1
      Caption         =   "BitField"
      Height          =   255
      Left            =   2400
      TabIndex        =   19
      Top             =   120
      Width           =   975
   End
   Begin Label lblID
      Caption         =   "Scount"
      Height          =   255
      Left            =   600
      TabIndex        =   15
      Top             =   120
      Width           =   1095
   End
   Begin Label lblFirstName
      Caption         =   "Class"
      Height          =   255
      Left            =   600
      TabIndex        =   14
      Top             =   1680
      Width           =   1335
   End
   Begin Label lblLastName
      Caption         =   "Name"
      Height          =   255
      Left            =   600
      TabIndex        =   13
      Top             =   840
      Width           =   975
   End
Option Explicit
Const SIZE = 11
Dim sQuote As String
Dim src As String
Dim criteria As String
Dim currentrecord As String
Const ERROR_MSG = "You have entered an Employee ID that already exists. Modify Employee ID before proceeding."
Const KEY_DELETE = &H2E
Sub cmdAdd_Click ()
    currentrecord = data1.Recordset.Bookmark
    data1.Recordset.AddNew
    'Show Save and Cancel - Disable Delete
    cmdSave.Visible = True
    cmdCancel.Visible = True
    cmdDelete.Enabled = False
    txtID.Enabled = True
    txtID.SetFocus
End Sub
Sub cmdCancel_Click ()
    'Restore position to where you were
    'when you started Adding records
     data1.Recordset.Bookmark = currentrecord
    'Reset buttons to show leaving Add mode
    ReSetButtons
End Sub
Sub cmdDelete_Click ()
    On Error Resume Next
    data1.Recordset.Delete
    data1.Recordset.MoveNext
    'If the last record was just deleted, move to the
    'new last record
    If data1.Recordset.EOF Then
        data1.Recordset.MoveLast
    End If
End Sub
Sub cmdEnd_Click ()
    Unload form1
End Sub
Sub cmdFind_Click ()
    sQuote = Chr$(34)
    'If Save is visible - you were in the middle of adding
    'Hide Save/Cancel to show ADD was cancelled.
    cmdSave.Visible = False
    cmdCancel.Visible = False
    'Save the current position.
    currentrecord = data1.Recordset.Bookmark
    src = InputBox$("Enter last name of employee to find", "Find Box")
    If src = "" Then Exit Sub
    criteria = "[Last Name] = " & sQuote & src & sQuote
    data1.Recordset.FindFirst criteria
    If data1.Recordset.NoMatch Then
        MsgBox "No Record Found!", , "What were you thinking?"
        data1.Recordset.Bookmark = currentrecord
    Else
        cmdNext.Enabled = True
        cmdPrior.Enabled = True
    End If
End Sub
Sub cmdFirst_Click ()
    data1.Recordset.MoveFirst
    cmdNext.Enabled = True
    cmdPrior.Enabled = False
End Sub
Sub cmdGrid_Click ()
    form1.Hide
    LoadFrame
    form2.Show
End Sub
Sub cmdLast_Click ()
    data1.Recordset.MoveLast
    cmdPrior.Enabled = True
    cmdNext.Enabled = False
End Sub
Sub cmdNext_Click ()
    data1.Recordset.MoveNext
    cmdPrior.Enabled = True
    If data1.Recordset.EOF Then
        data1.Recordset.MoveLast
        cmdNext.Enabled = False
    End If
End Sub
Sub cmdPrior_Click ()
    data1.Recordset.MovePrevious
    cmdNext.Enabled = True
    If data1.Recordset.BOF Then
        data1.Recordset.MoveFirst
        cmdPrior.Enabled = False
    End If
End Sub
Sub cmdSave_Click ()
    On Error GoTo SaveError
    data1.UpdateRecord
    cmdSave.Visible = False
    cmdCancel.Visible = False
    'Reset buttons to show leaving Add mode
    ReSetButtons
    'Disable the key field
    txtID.Enabled = False
TerminateSave:
    Exit Sub
SaveError:
    If Err = 3022 Then
        MsgBox ERROR_MSG
        txtID.SelStart = 0
        txtID.SelLength = Len(txtID.Text)
        txtID.SetFocus
    Else
        MsgBox Error$
    End If
    Resume TerminateSave
End Sub
Sub cmdUpdate_Click ()
    'Invoke Data1.UpdateRecord rather
    'than Data1.RecordSet.Update.
    'Data1.UpdateRecord saves a record
    'but DOES NOT invoke Validation Event.
    'We don't want to prompt user to save
    'if he or she explicitly chose Update.
    data1.UpdateRecord
    cmdUpdate.Enabled = False
End Sub
Sub Data1_Error (DataErr As Integer, response As Integer)
    Const CONTINUE = 0
    If DataErr = 3022 Then
        MsgBox ERROR_MSG
        txtID.SelStart = 0
        txtID.SelLength = Len(txtID.Text)
        txtID.SetFocus
        response = CONTINUE
    End If
End Sub
Sub Data1_Reposition ()
    cmdUpdate.Enabled = False
End Sub
Sub Data1_Validate (Action As Integer, Save As Integer)
    Const IDNO = 7
    If Save = True Then
        'We will prompt the user to save record
        'for all actions EXCEPT ADD.
        'If the user selected ADD then ADD again,
        'we do not want to issue prompt. (Ation 5 is Add)
        'However, if Update button is visible, that
        'means the user user modified a record
        'but has not saved it yet.
        'In this case, we should issue prompt.
        If Action <> 5 Or cmdUpdate.Enabled = True Then
            If MsgBox("save?", 4) = IDNO Then
              Save = False
              data1.UpdateControls
          End If
        End If
    End If
    If Action <> 5 Then
        'Reset Buttons to show leaving Add mode
         ReSetButtons
    End If
End Sub
Sub Form_Load ()
    'make Save and Cancel invisible
    cmdSave.Visible = False
    cmdCancel.Visible = False
End Sub
Sub ReSetButtons ()
    'ReEnableButtons is called whenever you Cancel
    'or save a record. It simply hides Save and Cancel
    'to show you are no longer in Add mode
    'and reenables Delete. (Delete is only valid
    'if you are not in Add mode.)
    'This routine is invoked from cmdSave, cmdCancel,
    'cmdFind and the Validation Event of data control
    cmdSave.Visible = False
    cmdCancel.Visible = False
    cmdDelete.Enabled = True
End Sub
Sub txtFirstName_KeyPress (KeyAscii As Integer)
    If cmdSave.Visible = False Then
        cmdUpdate.Enabled = True
    End If
End Sub
Sub txtLastName_KeyDown (KeyCode As Integer, Shift As Integer)
    If KeyCode = KEY_DELETE And cmdSave.Visible = False Then
        cmdUpdate.Enabled = True
    End If
End Sub
Sub txtLastName_KeyPress (KeyAscii As Integer)
    If cmdSave.Visible = False Then
        cmdUpdate.Enabled = True
    End If
End Sub