Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'當前操作的記錄集
Dim WithEvents adoprimaryrs As Recordset
Attribute adoprimaryrs.VB_VarHelpID = -1
Dim mbChangedByCode As Boolean
'BookMark標記
Dim mvBookMark As Variant
'是否處在編輯狀態
Dim mbEditFlag As Boolean
'是否處在新增記錄狀態
Dim mbAddNewFlag As Boolean
'當前數據是否被改變
Dim mbDataChanged As Boolean

Private Sub cmdSearch_Click()
    txtSearch = UCase(Trim(txtSearch))
    adoprimaryrs.MoveFirst
    adoprimaryrs.Find (comSearch.Text & "='" & txtSearch & "'")
    If adoprimaryrs.AbsolutePosition < 0 Then
        MsgBox comSearch & " 沒找到!!!", vbInformation, "注意"
        adoprimaryrs.MoveFirst
    End If
End Sub

Private Sub Form_Load()
    Dim db As Connection
    Set db = New Connection
    db.CursorLocation = adUseClient
    db.Open strConnection

    Set adoprimaryrs = New Recordset
    adoprimaryrs.Open "select Subject,NoOfBooks,IssueDays," & _
                        "FineCharge,ReserveCharge from Subjects", _
                        db, adOpenStatic, adLockOptimistic

    Dim oText As TextBox
    
    '動態綁定所有TextBox到數據源
    For Each oText In Me.txtFields
        Set oText.DataSource = adoprimaryrs
    Next
    mbDataChanged = False
    
    '指定搜索字段
    comSearch.AddItem ("Subject")
    comSearch.ListIndex = 0
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)
    '顯示當前記錄的位置
    lblStatus.Caption = "記錄: " & CStr(adoprimaryrs.AbsolutePosition)
End Sub

Private Sub adoPrimaryRS_WillChangeRecord(ByVal adReason As ADODB.EventReasonEnum, ByVal cRecords As Long, adStatus As ADODB.EventStatusEnum, ByVal pRecordset As ADODB.Recordset)
    '這里是放置驗證代碼的地方
    '下面這些事件激發此事件發生
    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 cmdAdd_Click()
    On Error GoTo AddErr
    With adoprimaryrs
        If Not (.BOF And .EOF) Then
            mvBookMark = .Bookmark
        End If
        .AddNew
        lblStatus.Caption = "添加記錄"
        mbAddNewFlag = True
        SetButtons False
    End With

    Exit Sub
AddErr:
    MsgBox "發生錯誤：" & Err.Description, vbExclamation, "錯誤"
End Sub

'"刪除"按鈕單擊事件響應代碼
Private Sub cmdDelete_Click()
    On Error GoTo DeleteErr
    With adoprimaryrs
        .Delete
        .MoveNext
        If .EOF Then .MoveLast
    End With
    Exit Sub
DeleteErr:
    MsgBox "發生錯誤：" & Err.Description, vbExclamation, "錯誤"
End Sub

'"刷新"按鈕單擊事件響應代碼
Private Sub cmdRefresh_Click()
    '多用戶情況下才需要使用
    On Error GoTo RefreshErr
    adoprimaryrs.Requery
    Exit Sub
RefreshErr:
    MsgBox "發生錯誤：" & Err.Description, vbExclamation, "錯誤"
End Sub

'"編輯"按鈕單擊事件響應代碼
Private Sub cmdEdit_Click()
    On Error GoTo EditErr

    lblStatus.Caption = "編輯記錄"
    mbEditFlag = True
    SetButtons False
    Exit Sub

EditErr:
    MsgBox "發生錯誤：" & Err.Description, vbExclamation, "錯誤"
End Sub

'"取消"按鈕單擊事件響應代碼
Private Sub cmdCancel_Click()
    On Error Resume Next

    SetButtons True
    mbEditFlag = False
    mbAddNewFlag = False
    adoprimaryrs.CancelUpdate
    If mvBookMark > 0 Then
        adoprimaryrs.Bookmark = mvBookMark
    Else
        adoprimaryrs.MoveFirst
    End If
    mbDataChanged = False

End Sub

'"更新"按鈕單擊事件響應代碼
Private Sub cmdUpdate_Click()
    On Error GoTo UpdateErr

    adoprimaryrs.UpdateBatch adAffectAll

    If mbAddNewFlag Then
        '移動到新記錄
        adoprimaryrs.MoveLast
    End If

    mbEditFlag = False
    mbAddNewFlag = False
    SetButtons True
    mbDataChanged = False

    Exit Sub
UpdateErr:
    MsgBox "發生錯誤：" & Err.Description, vbExclamation, "錯誤"
End Sub

Private Sub cmdClose_Click()
    Unload Me
End Sub

'"移動到首記錄"按鈕單擊事件響應代碼
Private Sub cmdFirst_Click()
    On Error GoTo GoFirstError
    adoprimaryrs.CancelUpdate
    adoprimaryrs.MoveFirst
    mbDataChanged = False
    Exit Sub

GoFirstError:
    MsgBox "發生錯誤：" & Err.Description, vbExclamation, "錯誤"
End Sub

'"移動到尾記錄"按鈕單擊事件響應代碼
Private Sub cmdLast_Click()
    On Error GoTo GoLastError
    adoprimaryrs.CancelUpdate
    adoprimaryrs.MoveLast
    mbDataChanged = False
    Exit Sub

GoLastError:
    MsgBox "發生錯誤：" & Err.Description, vbExclamation, "錯誤"
End Sub

'"移動到下一條記錄"按鈕單擊事件響應代碼
Private Sub cmdNext_Click()
    On Error GoTo GoNextError
    adoprimaryrs.CancelUpdate
    If Not adoprimaryrs.EOF Then adoprimaryrs.MoveNext
    If adoprimaryrs.EOF And adoprimaryrs.RecordCount > 0 Then
        Beep
        '超出記錄尾，需要恢復
        adoprimaryrs.MoveLast
    End If
    '顯示當前記錄
    mbDataChanged = False
    Exit Sub

GoNextError:
    MsgBox "發生錯誤：" & Err.Description, vbExclamation, "錯誤"
End Sub

'移動到上一條記錄"按鈕單擊事件響應代碼
Private Sub cmdPrevious_Click()
    On Error GoTo GoPrevError
    adoprimaryrs.CancelUpdate
    If Not adoprimaryrs.BOF Then adoprimaryrs.MovePrevious
    If adoprimaryrs.BOF And adoprimaryrs.RecordCount > 0 Then
        Beep
        '超出記錄頭，需要恢復
        adoprimaryrs.MoveFirst
    End If
    '顯示當前記錄
    mbDataChanged = False
    Exit Sub

GoPrevError:
    MsgBox "發生錯誤：" & Err.Description, vbExclamation, "錯誤"
End Sub

Private Sub SetButtons(bVal As Boolean)
    cmdAdd.Visible = bVal
    cmdEdit.Visible = bVal
    cmdUpdate.Visible = Not bVal
    cmdCancel.Visible = Not bVal
    cmdDelete.Visible = bVal
    cmdClose.Visible = bVal
    cmdRefresh.Visible = bVal
    cmdNext.Enabled = bVal
    cmdFirst.Enabled = bVal
    cmdLast.Enabled = bVal
    cmdPrevious.Enabled = bVal
    Frame1.Enabled = bVal
  
End Sub
Private Sub txtFields_LostFocus(Index As Integer)
    '移除多余的空格
    txtFields(Index).Text = Trim(txtFields(Index).Text)

    If Index = 0 Then
        txtFields(Index).Text = UCase(txtFields(Index).Text)
    Else
        If Not IsNumeric(txtFields(Index).Text) Then
            MsgBox "請輸入數字!!!", vbInformation
            txtFields(Index).Text = ""
            txtFields(Index).SetFocus
        End If

    End If
End Sub