Application developed with Visual Basic, Part 5.

 

  1. The Book.frm View Code - Part 1, after modification.

    Resume :
    • To display the 2nd KJV database record into the Record data boxes, at the 1st time.

      Note
      :
      The 1st record of the database file - KJV.mdb stores option information.
    • To move the current record position to the first, last, next, or previous record. (Using the navigation controls).

    View Code, examine these changes:
    -
    The new text Code to be add is red.
    -
    The text Code to be remove is navy and Strikethrough effects.

    Dim WithEvents adoPrimaryRS As Recordset
    Dim mbChangedByCode As Boolean
    Dim mvBookMark As Variant
    Dim mbEditFlag As Boolean
    Dim mbAddNewFlag As Boolean
    Dim mbDataChanged As Boolean


    Dim strdatasource As String
    -----------------------------------------------------------------------------------------------------------------------
    Private Sub Form_Load()
    'Value of strdatasource at current directory
    strdatasource = App.Path + "\res\KJV.mdb"

    Dim db As Connection
    Set db = New Connection
    db.CursorLocation = adUseClient
    db.Open "PROVIDER=Microsoft.Jet.OLEDB.3.51;Data Source=" & strdatasource

    Set adoPrimaryRS = New Recordset
    adoPrimaryRS.Open "select Book,BookTitle,Chapter,TextData,Verse from BibleTable", db, adOpenStatic, adLockOptimistic

    'Load icon - BookIco.ico
    Set Me.Icon = LoadPicture(App.Path & "\res\BookIco.ico")

    'Load the picture - forum.gif
    Set Image1.Picture = LoadPicture(App.Path & "\res\forum.gif")

    '
    The TextBox datasource
    Set Me.txtFields.DataSource = adoPrimaryRS

    'The database operation begin with the 2nd record
    adoPrimaryRS.Move (Str(2))

    ' Disable the CmdFirst and CmdPrevious CommandButtons
    CmdFirst.Enabled = False
    CmdPrevious.Enabled = False

    'Values of the Book, Title, Chapter and Verse fields
    Call LabelAddress


    Dim oText As TextBox
    'Bind the text boxes to the data provider
    For Each oText In Me.txtFields
    Set oText.DataSource = adoPrimaryRS
    Next


    mbDataChanged = False


    End Sub
    -----------------------------------------------------------------------------------------------------------------------
    Private Sub Form_Resize()
    On Error Resume Next
    lblStatus.Width = Me.Width - 1500
    CmdNext.Left = lblStatus.Width + 700
    CmdLast.Left = CmdNext.Left + 340


    ' Image1 control size
    Image1.Left = (Picture1.Width - Image1.Width) / 2
    Image1.Top = (Picture1.Height - Image1.Height) / 2


    End Sub
    -----------------------------------------------------------------------------------------------------------------------
    Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
    If mbEditFlag Or mbAddNewFlag Then Exit Sub

    Select Case KeyCode
    Case vbKeyEscape
    cmdClose_Click
    Case vbKeyEnd
    cmdLast_Click
    Case vbKeyHome
    cmdFirst_Click
    Case vbKeyUp, vbKeyPageUp
    If Shift = vbCtrlMask Then
    cmdFirst_Click
    Else
    cmdPrevious_Click
    End If
    Case vbKeyDown, vbKeyPageDown
    If Shift = vbCtrlMask Then
    cmdLast_Click
    Else
    cmdNext_Click
    End If
    End Select
    End Sub

    -----------------------------------------------------------------------------------------------------------------------
    Private Sub Form_Unload(Cancel As Integer)
    Screen.MousePointer = vbDefault
    End Sub
    -----------------------------------------------------------------------------------------------------------------------
    Private Sub adoPrimaryRS_MoveComplete(ByVal adReason As ADODB.EventReasonEnum, ByVal pError As ADODB.Error, adStatus As ADODB.EventStatusEnum, ByVal pRecordset As ADODB.Recordset)
    'This will display the current record position for this recordset
    'The database operation of the application begins with the 2nd KJV database record.
    lblStatus.Caption = "Record: " & CStr(adoPrimaryRS.AbsolutePosition - 1)
    End Sub
    -----------------------------------------------------------------------------------------------------------------------
    Private Sub adoPrimaryRS_WillChangeRecord(ByVal adReason As ADODB.EventReasonEnum, ByVal cRecords As Long, adStatus As ADODB.EventStatusEnum, ByVal pRecordset As ADODB.Recordset)
    'This is where you put validation code
    'This event gets called when the following actions occur
    Dim bCancel As Boolean

    Select Case adReason
    Case adRsnAddNew
    Case adRsnClose
    Case adRsnDelete
    Case adRsnFirstChange
    Case adRsnMove
    Case adRsnRequery
    Case adRsnResynch
    Case adRsnUndoAddNew
    Case adRsnUndoDelete
    Case adRsnUndoUpdate
    Case adRsnUpdate
    End Select

    If bCancel Then adStatus = adStatusCancel
    End Sub

    -----------------------------------------------------------------------------------------------------------------------
    Private Sub cmdClose_Click()
    Unload Me
    End Sub
    -----------------------------------------------------------------------------------------------------------------------
    Private Sub cmdFirst_Click()
    On Error GoTo GoFirstError

    adoPrimaryRS.MoveFirst
    mbDataChanged = False
    ' Begin with the 2nd record
    adoPrimaryRS.Move (2)

    CmdFirst.Enabled = False
    CmdPrevious.Enabled = False
    If CmdLast.Enabled = False Or CmdNext.Enabled = False Then
    CmdLast.Enabled = True
    CmdNext.Enabled = True
    End If

    Call LabelAddress

    Exit Sub

    GoFirstError:
    MsgBox Err.Description
    End Sub
    -----------------------------------------------------------------------------------------------------------------------
    Private Sub cmdLast_Click()
    On Error GoTo GoLastError

    adoPrimaryRS.MoveLast
    mbDataChanged = False
    CmdLast.Enabled = False
    CmdNext.Enabled = False
    If CmdFirst.Enabled = False Or CmdPrevious.Enabled = False Then
    CmdFirst.Enabled = True
    CmdPrevious.Enabled = True
    End If

    Call LabelAddress

    Exit Sub

    GoLastError:
    MsgBox Err.Description
    End Sub
    -----------------------------------------------------------------------------------------------------------------------
    Private Sub cmdNext_Click()
    On Error GoTo GoNextError

    If Not adoPrimaryRS.EOF Then adoPrimaryRS.MoveNext
    If CmdFirst.Enabled = False Or CmdPrevious.Enabled = False Then
    CmdFirst.Enabled = True
    CmdPrevious.Enabled = True
    End If

    If adoPrimaryRS.EOF And adoPrimaryRS.RecordCount > 0 Then
    Beep
    'moved off the end so go back
    adoPrimaryRS.MoveLast

    CmdLast.Enabled = False
    CmdNext.Enabled = False

    End If
    'show the current record
    mbDataChanged = False


    Call LabelAddress

    Exit Sub
    GoNextError:
    MsgBox Err.Description
    End Sub
    -----------------------------------------------------------------------------------------------------------------------
    Private Sub cmdPrevious_Click()
    On Error GoTo GoPrevError

    If Not adoPrimaryRS.BOF Then adoPrimaryRS.MovePrevious
    If adoPrimaryRS.BOF And adoPrimaryRS.RecordCount > 0 Then
    Beep
    'moved off the end so go back
    adoPrimaryRS.MoveFirst
    End If
    'show the current record
    mbDataChanged = False

    If Not adoPrimaryRS.BOF And adoPrimaryRS.AbsolutePosition > 2 Then adoPrimaryRS.MovePrevious
    If CmdLast.Enabled = False Or CmdNext.Enabled = False Then
    CmdLast.Enabled = True
    CmdNext.Enabled = True
    End If

    If adoPrimaryRS.AbsolutePosition = 3 Then
    Beep
    CmdFirst.Enabled = False
    CmdPrevious.Enabled = False

    End If

    Call LabelAddress

    Exit Sub

    GoPrevError:
    MsgBox Err.Description
    End Sub
    -----------------------------------------------------------------------------------------------------------------------
    Private Sub SetButtons(bVal As Boolean)
    CmdClose.Visible = bVal
    CmdNext.Enabled = bVal
    CmdFirst.Enabled = bVal
    CmdLast.Enabled = bVal
    CmdPrevious.Enabled = bVal
    End Sub

    -----------------------------------------------------------------------------------------------------------------------
    ' Values of the Book, Title, Chapter and Verse fields
    Private Sub LabelAddress()
    Titre.Caption = "Book : " +
    Trim(adoPrimaryRS.Fields.Item(0).Value) + " Title : " + Trim(adoPrimaryRS.Fields.Item(1).Value)
    Chapter.Caption = "Chapter : " + Trim(adoPrimaryRS.Fields.Item(2).Value) + " Verse : " + Trim(adoPrimaryRS.Fields.Item(4).Value)

    End Sub

    --------------------------------------------------------------------------------------------------------------------------


     

  2. Remove the file Book.frx from  the folder C:\Test\Test VB0.

    Note
    :
    Because the style of the navigation buttons - (CmdFirst, CmdPrevious, CmdNext and CmdLast) is standard (no graphic).
  3. To save this application; From File menu, choose and click Save Project.
  4. To run it; From Run menu, choose and click Start.

Previous
Home 5 Home
Next