Application developed with Visual Basic, Part 9. |
|
View Code, examine these changes - the new text
Code to be add is red.
Dim
WithEvents adoPrimaryRS As Recordset 'Type of AdRecordset Dim AdRecordset1 As Recordset ' Type of strdatasource Dim strdatasource As String ------------------------------------------------------------------------------------------------------------------- Private Sub cmddisplay_Click() Dim NVar As Long //Variables Dim vstring As String Dim vfield1 As String Dim vword As String 'Database declaration Dim db As Connection Set db = New Connection db.CursorLocation = adUseClient db.Open "PROVIDER=Microsoft.Jet.OLEDB.3.51;Data Source=" & strdatasource Set AdRecordset1 = New Recordset AdRecordset1.Open "select Book,BookTitle,Chapter,TextData,Verse from BibleTable", db, adOpenStatic, adLockOptimistic TxtWord.Enabled = False List1.Clear 'Convert the value of TxtWord control to uppercase or lowercase letters/characters vword = UCase(Left(Trim(TxtWord.Text), 1)) + (LCase(Right(Trim(TxtWord.Text), (Len(Trim(TxtWord.Text)) - 1)))) 'Search operation With AdRecordset1 NVar = 0 .MoveFirst .Move (2) Do While Not .EOF If InStr(.Fields(3).Value, LCase(Trim(TxtWord.Text))) Or _ InStr(.Fields(3).Value, UCase(Trim(TxtWord.Text))) Or _ InStr(.Fields(3).Value, vword) Then 'Title value vfield1 = .Fields(1).Value & Space(16 - Len(.Fields(1).Value)) 'Value of the List Item vstring = Format(Str(Val(.AbsolutePosition - 1)), "00000") + " " + Format(.Fields(0).Value, "00") + " " + vfield1 + " " + Trim(.Fields(2).Value) + " " + Trim(.Fields(4).Value) List1.AddItem vstring NVar = NVar + 1 'Display the number of the items found If NVar > 5000 Then lbinfo1.Caption = " More then " + Str(NVar) + " items found Select ..." TxtWord.Enabled = True Cmddisplay.Enabled = False Exit Sub End If End If .MoveNext Loop End With If NVar > 0 Then lbinfo1.Caption = " " + Str(NVar) + " items found. Select ..." Else lbinfo1.Caption = "no item found" End If TxtWord.Enabled = True Cmddisplay.Enabled = False Exit Sub End Sub ------------------------------------------------------------------------------------------------------------------------ Private Sub cmddisplay_GotFocus() lbinfo1.Caption = "Moment ..." End Sub ----------------------------------------------------------------------------------------------------------------------- Private Sub Form_Load() 'Data Soure at current directory strdatasource = App.Path + "\res\KJV.mdb" 'Declare the adoPrimaryRS 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") 'Load the picture - Christus-th.gif Set Image2.Picture = LoadPicture(App.Path & "\res\Christus-th.gif") 'The datasource value of TextBox Set Me.txtFields.DataSource = adoPrimaryRS 'The database file Begin with the 2nd adoPrimaryRS.Move (Str(2)) ' Disable the CmdFirst and CmdPrevious CommandButtons with begin CmdFirst.Enabled = False CmdPrevious.Enabled = False 'Calcul the values of book, title, chapter and verse Call LabelAddress 'Tabstrip control For i = 0 To Frtb.Count - 1 With Frtb(i) .Move TabStrip1.ClientLeft, _ TabStrip1.ClientTop, _ TabStrip1.ClientWidth, _ TabStrip1.ClientHeight End With Next i ' Bring the first frTb control to the front. Frtb(0).ZOrder 0 End Sub ----------------------------------------------------------------------------------------------------------------------- Private Sub Form_Resize() 'Image1 control size Image1.Left = (Picture1.Width - Image1.Width) / 2 Image1.Top = (Picture1.Height - Image1.Height) / 2 'Image2 control size Image2.Left = (Picture2.Width - Image2.Width) / 2 Image2.Top = (Picture2.Height - Image2.Height) / 2 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 'In Visual Basic, the order of records begin with number 0 lblStatus.Caption = "Record: " & CStr(adoPrimaryRS.AbsolutePosition - 1) End Sub ----------------------------------------------------------------------------------------------------------------------- Private Sub cmdClose_Click() Unload Me End Sub ---------------------------------------------------------------------------------------------------------------------- Private Sub cmdFirst_Click() On Error GoTo GoFirstError adoPrimaryRS.MoveFirst 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 CmdLast.Enabled = False CmdNext.Enabled = False End If Call LabelAddress Exit Sub GoNextError: MsgBox Err.Description End Sub ----------------------------------------------------------------------------------------------------------------------- Private Sub cmdPrevious_Click() On Error GoTo GoPrevError 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 ----------------------------------------------------------------------------------------------------------------------- Private Sub List1_Click() If List1.ListCount > 0 Then If CmdFirst.Enabled = False Or CmdLast.Enabled = False Then SetButtons True End If 'Into the Record data boxes, displays the record corresponding to the list item selected adoPrimaryRS.MoveFirst adoPrimaryRS.Move (Val(Left(List1.Text, 5))) Call LabelAddress End If End Sub ----------------------------------------------------------------------------------------------------------------------- 'Calcul the values of book, title, chapter and verse 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 ---------------------------------------------------------------------------------------------------------------------- Private Sub TabStrip1_Click() Frtb(TabStrip1.SelectedItem.Index - 1).ZOrder 0 End Sub ----------------------------------------------------------------------------------------------------------------------- Private Sub TxtWord_KeyPress(KeyAscii As Integer) 'The Cmddisplay is enabled, if the lenght of the word typed in the TxtWord control > 1 If Len(TxtWord.Text) > 1 Then Cmddisplay.Enabled = True End If End Sub |