Application developed with Visual Basic, Part 5. |
|
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 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 '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() 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 ----------------------------------------------------------------------------------------------------------------------- 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 ----------------------------------------------------------------------------------------------------------------------- '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 ' 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 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 mbDataChanged = False Call LabelAddress Exit Sub GoNextError: MsgBox Err.Description End Sub ----------------------------------------------------------------------------------------------------------------------- Private Sub cmdPrevious_Click() On Error GoTo GoPrevError 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 -------------------------------------------------------------------------------------------------------------------------- |