⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 vrental_engine.cls

📁 ado+ACCE
💻 CLS
📖 第 1 页 / 共 5 页
字号:
    End If
 '-------- START ADDING ----------
                    rec.AddNew
                    rec.Fields("Title") = Trim(txtTitle.Text)
                    rec.Fields("Date Entered") = Trim(txtDateEntered.Text)
                    rec.Fields("Item Code") = Trim(txtItemCode.Text)
                    rec.Fields("Actor") = Trim(txtActor.Text)
                    rec.Fields("Year Released") = Trim(txtYearReleased.Text)
                    rec.Fields("Genre") = Trim(txtGenre.Text)
                    rec.Fields("Run Time") = Trim(txtRunTime.Text)
                    rec.Fields("Rental Amount") = Trim(txtRentalAmount.Text)
                    rec.Fields("Available") = Trim(txtAvailable.Text)
                    rec.Fields("RentalPeriod") = Trim(txtRentalPeriod.Text)
                    rec.Fields("OverdueChargePerDay") = Trim(txtOverdueChargePerDay.Text)
                    If IsDate(Trim(txtLastDateBorrowed.Text)) = True Then rec.Fields("LastDateBorrowed") = Trim(txtLastDateBorrowed.Text)
                    rec.Fields("LastDateBorrowedAddInfo") = Trim(txtLastDateBorrowedAddInfo.Text)
                    If IsDate(Trim(txtLastDateReturned.Text)) = True Then rec.Fields("LastDateReturned") = Trim(txtLastDateReturned.Text)
                    rec.Fields("LastDateReturnedAddInfo") = Trim(txtLastDateReturnedAddInfo.Text)
                    rec.Fields("Condition") = Trim(txtCondition.Text)
                    rec.Fields("Comments") = Trim(txtComments.Text)
                    rec.Update
 '-------- END ADDING ------------
     
   db.Close
   MsgBox "Another item has been added. ", vbInformation, "Adding Successful"
   Add_CD_TAPES_MovieToDB = True

End Function

Function UpdateEditedCDtapesInfo(tmpItemCodeB4Edit As String, txtTitle As TextBox, txtDateEntered As TextBox, txtItemCode As TextBox, _
                    txtActor As TextBox, txtYearReleased As TextBox, txtGenre As TextBox, txtRunTime As TextBox, txtRentalAmount As TextBox, _
                    txtAvailable As TextBox, txtRentalPeriod As TextBox, txtOverdueChargePerDay As TextBox, txtLastDateBorrowed As TextBox, txtLastDateBorrowedAddInfo As TextBox, txtLastDateReturned As TextBox, _
                    txtLastDateReturnedAddInfo As TextBox, txtCondition As TextBox, txtComments As TextBox) As Boolean
 Dim db As Database
    Dim rec As Recordset
    Dim TDM As Variant
    Dim loop1 As Integer
    
    Set db = OpenDatabase(App.Path & "\Database\CD_Tapes.mdb" _
             , False, False, ";pwd=AdmiN")
    Set rec = db.OpenRecordset("CD Tapes Table", dbOpenTable)
    
    ' Start for ItemCode duplicates
      If tmpItemCodeB4Edit <> Trim(txtItemCode.Text) Then
             
            rec.MoveFirst
            For loop1 = 1 To rec.RecordCount
                TDM = DoEvents()
                If Trim(txtItemCode.Text) = rec.Fields("Item Code") Then
                    MsgBox "Item Code already in use. ", vbInformation, "Update ERROR!"
                    db.Close
                     UpdateEditedCDtapesInfo = False
                    Exit Function
                End If
                If rec.EOF = False Then rec.MoveNext
            Next loop1
      
      End If
    ' End check 4 Item code duplicates
    ' Start - Look 4 record
      rec.MoveFirst
      For loop1 = 1 To rec.RecordCount
                TDM = DoEvents()
                If tmpItemCodeB4Edit = rec.Fields("Item Code") Then
                    Exit For
                End If
                If rec.EOF = False Then rec.MoveNext
      Next loop1

    ' End - Look 4 rec to edit
 '-------- START Update Edit ----------
              
                    rec.Edit
                    rec.Fields("Title") = Trim(txtTitle.Text)
                    rec.Fields("Date Entered") = Trim(txtDateEntered.Text)
                    rec.Fields("Item Code") = Trim(txtItemCode.Text)
                    rec.Fields("Actor") = Trim(txtActor.Text)
                    rec.Fields("Year Released") = Trim(txtYearReleased.Text)
                    rec.Fields("Genre") = Trim(txtGenre.Text)
                    rec.Fields("Run Time") = Trim(txtRunTime.Text)
                    rec.Fields("Rental Amount") = Trim(txtRentalAmount.Text)
                    rec.Fields("Available") = Trim(txtAvailable.Text)
                    rec.Fields("RentalPeriod") = Trim(txtRentalPeriod.Text)
                    rec.Fields("OverdueChargePerDay") = Trim(txtOverdueChargePerDay.Text)
                    If IsDate(Trim(txtLastDateBorrowed.Text)) = False Then
                         rec.Fields("LastDateBorrowed") = Null
                    Else
                         rec.Fields("LastDateBorrowed") = Trim(txtLastDateBorrowed.Text)
                    End If
                    rec.Fields("LastDateBorrowedAddInfo") = Trim(txtLastDateBorrowedAddInfo.Text)
                    If IsDate(Trim(txtLastDateReturned.Text)) = False Then
                       rec.Fields("LastDateReturned") = Null
                    Else
                       rec.Fields("LastDateReturned") = Trim(txtLastDateReturned.Text)
                    End If
                    rec.Fields("LastDateReturnedAddInfo") = Trim(txtLastDateReturnedAddInfo.Text)
                    rec.Fields("Condition") = Trim(txtCondition.Text)
                    rec.Fields("Comments") = Trim(txtComments.Text)
                    rec.Update
 '-------- END Update Edit ------------
     
   db.Close
   MsgBox "Record has been updated. ", vbInformation, "Update Successful"
  UpdateEditedCDtapesInfo = True

End Function

Sub Remove_CD_tape_Items(ItemCode As String)

 Dim db As Database
    Dim rec As Recordset
    Dim TDM As Variant
    Dim loop1 As Integer
    
    Set db = OpenDatabase(App.Path & "\Database\CD_Tapes.mdb" _
             , False, False, ";pwd=AdmiN")
    Set rec = db.OpenRecordset("CD Tapes Table", dbOpenTable)
   
            rec.MoveFirst
            For loop1 = 1 To rec.RecordCount
                TDM = DoEvents()
                If ItemCode = rec.Fields("Item Code") Then
                    rec.Delete
                    db.Close
                    Exit For
                End If
                If rec.EOF = False Then rec.MoveNext
            Next loop1
      MsgBox "Record has been successfully removed. ", vbInformation, "Record removed"
End Sub

Sub Search_Movies(FlexMovies As MSFlexGrid, SearchString As String, SearchFields As String, SearchMode As Boolean, SortByFields As String, SortMode As Boolean)
    Dim TDM As Variant
    Dim loop1, loop2 As Long
    Dim mySQL As String
    Dim adoConnection As ADODB.Connection
    Dim adoRecordset As ADODB.Recordset
    Dim connectString As String

    Set adoConnection = New ADODB.Connection
    Set adoRecordset = New ADODB.Recordset

    connectString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "\DataBase\CD_Tapes.mdb;Persist Security Info=False;Jet OLEDB:Database Password=AdmiN"

    adoConnection.Open connectString
   

    

With FlexMovies
    .ColWidth(0) = 600
    .ColWidth(1) = 1250
    .ColWidth(2) = 1350
    .ColWidth(3) = 2250
    .ColWidth(4) = 1900
    .ColWidth(5) = 1100
    .ColWidth(6) = 1180
    .ColWidth(7) = 900

    .TextMatrix(0, 0) = "No."
    .TextMatrix(0, 1) = "Item Code"
    .TextMatrix(0, 2) = "Date Entered"
    .TextMatrix(0, 3) = "Title"
    .TextMatrix(0, 4) = "Actor"
    .TextMatrix(0, 5) = "Genre"
    .TextMatrix(0, 6) = "Year Released"
    .TextMatrix(0, 7) = "Available"
    
End With


'' ---------Start SQL
  If SearchString = "[All Movies]" Or SearchString = "*" Or SearchString = "" Then
     mySQL = "SELECT * from [CD Tapes Table] ORDER by [" & SortByFields & "]"
  Else
     If SearchMode = True Then
        mySQL = "SELECT * from [CD Tapes Table] WHERE [" & SearchFields & "] LIKE '%" & SearchString & "%' ORDER by [" & SortByFields & "]"
     Else
        mySQL = "SELECT * from [CD Tapes Table] WHERE [" & SearchFields & "] = " & """" & SearchString & """" & "ORDER by [" & SortByFields & "]"
     End If
  End If
adoRecordset.Open mySQL, adoConnection, adOpenStatic, adLockOptimistic, _
           adCmdText
'' --------End SQL

If adoRecordset.BOF = True And adoRecordset.EOF = True Then
           MsgBox "No records found matching your search. ", vbInformation, "Not found"
           Exit Sub
End If
Select Case SortMode
Case True:
  '---------- Forward Processing ------------------------------------------
        FlexMovies.Rows = 1
        loop1 = 0
        
        adoRecordset.MoveFirst
        Do Until adoRecordset.EOF
             TDM = DoEvents()
             loop1 = loop1 + 1
             FlexMovies.AddItem ""
                For loop2 = 0 To 7
                    Select Case loop2
                        Case 0:
                                FlexMovies.TextMatrix(loop1, loop2) = str(loop1)
                        Case 1:
                                FlexMovies.TextMatrix(loop1, loop2) = adoRecordset![Item Code]
                        Case 2:
                                FlexMovies.TextMatrix(loop1, loop2) = adoRecordset![Date Entered]
                        Case 3:
                                FlexMovies.TextMatrix(loop1, loop2) = adoRecordset!Title
                        Case 4:
                                FlexMovies.TextMatrix(loop1, loop2) = adoRecordset!actor
                        Case 5:
                                FlexMovies.TextMatrix(loop1, loop2) = adoRecordset!Genre
                        Case 6:
                                FlexMovies.TextMatrix(loop1, loop2) = adoRecordset![Year Released]
                        Case 7:
                                FlexMovies.TextMatrix(loop1, loop2) = adoRecordset!Available
                    End Select
                Next loop2
            adoRecordset.MoveNext
         Loop
         'FlexMovies.Rows = FlexMovies.Rows - 1
  '-----------------------------------------------
Case False:
'---START--- Backward Proceesing (Sort)
Dim tmpArray() As Variant
Dim counter, countdown As Long
counter = 0
loop1 = 0
        adoRecordset.MoveFirst
        FlexMovies.Rows = 1
        Do Until adoRecordset.EOF
             TDM = DoEvents()
             loop1 = loop1 + 1
             counter = counter + 8
             ReDim Preserve tmpArray(counter)
             'FlexMovies.AddItem ""
                For loop2 = 0 To 7
                    Select Case loop2
                        Case 0:
                                tmpArray(counter - 7 + loop2) = str(loop1)
                        Case 1:
                                tmpArray(counter - 7 + loop2) = adoRecordset![Item Code]
                        Case 2:
                                tmpArray(counter - 7 + loop2) = adoRecordset![Date Entered]
                        Case 3:
                                tmpArray(counter - 7 + loop2) = adoRecordset!Title
                        Case 4:
                                tmpArray(counter - 7 + loop2) = adoRecordset!actor
                        Case 5:
                                tmpArray(counter - 7 + loop2) = adoRecordset!Genre
                        Case 6:
                                tmpArray(counter - 7 + loop2) = adoRecordset![Year Released]
                        Case 7:
                                tmpArray(counter - 7 + loop2) = adoRecordset!Available
                    End Select
                    
                Next loop2

            adoRecordset.MoveNext
         Loop
       '------ Start Backward display
       For loop1 = 1 To counter
      ' Debug.Print Str(loop1) & ": " & tmpArray(loop1)
       Next
       loop1 = 0
        adoRecordset.MoveFirst
        countdown = counter
        For loop1 = 1 To counter / 8
             TDM = DoEvents()
             FlexMovies.AddItem ""
                                FlexMovies.TextMatrix(loop1, 7) = tmpArray(countdown)
                                countdown = countdown - 1
                                FlexMovies.TextMatrix(loop1, 6) = tmpArray(countdown)
                                countdown = countdown - 1
                                FlexMovies.TextMatrix(loop1, 5) = tmpArray(countdown)
                                countdown = countdown - 1
                                FlexMovies.TextMatrix(loop1, 4) = tmpArray(countdown)
                                countdown = countdown - 1
                                FlexMovies.TextMatrix(loop1, 3) = tmpArray(countdown)
                                countdown = countdown - 1
                                FlexMovies.TextMatrix(loop1, 2) = tmpArray(countdown)
                                countdown = countdown - 1
                                FlexMovies.TextMatrix(loop1, 1) = tmpArray(countdown)
                                countdown = countdown - 1
                                FlexMovies.TextMatrix(loop1, 0) = str(loop1)
                                countdown = countdown - 1
      Next loop1

'---END--- Backward Proceesing (Sort)
 End Select
 
 
 
adoRecordset.Close
adoConnection.Close
Set adoRecordset = Nothing
Set adoConnection = Nothing

End Sub

Sub Search_Members(FlexMembers As MSFlexGrid, SearchString As String, SearchFields As String, SearchMode As Boolean, SortByFields As String, SortMode As Boolean)
    
    Dim TDM As Variant
    Dim loop1, loop2 As Long
    Dim mySQL As String
    Dim adoConnection As ADODB.Connection
    Dim adoRecordset As ADODB.Recordset
    Dim connectString As String

    Set adoConnection = New ADODB.Connection
    Set adoRecordset = New ADODB.Recordset

    connectString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "\DataBase\MembersDB.mdb;Persist Security Info=False;Jet OLEDB:Database Password=AdmiN"

    adoConnection.Open connectString
   

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -