Top             =   1340
      Width           =   1815
   End
   Begin VB.Label lblLabels 
      Caption         =   "存在:"
      Height          =   255
      Index           =   3
      Left            =   120
      TabIndex        =   6
      Top             =   1020
      Width           =   1815
   End
   Begin VB.Label lblLabels 
      Caption         =   "狀況:"
      Height          =   255
      Index           =   2
      Left            =   120
      TabIndex        =   4
      Top             =   700
      Width           =   1815
   End
   Begin VB.Label lblLabels 
      Caption         =   "書本編號:"
      Height          =   255
      Index           =   1
      Left            =   120
      TabIndex        =   2
      Top             =   380
      Width           =   1815
   End
   Begin VB.Label lblLabels 
      Caption         =   "書籍編號:"
      Height          =   255
      Index           =   0
      Left            =   120
      TabIndex        =   0
      Top             =   60
      Width           =   1815
   End
End
Attribute VB_Name = "frmBooks"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim WithEvents adoprimaryrs As Recordset
Attribute adoprimaryrs.VB_VarHelpID = -1
Dim WithEvents adoprimaryrs2 As Recordset
Attribute adoprimaryrs2.VB_VarHelpID = -1
Dim mbChangedByCode As Boolean
Dim mvBookMark As Variant
Dim mbEditFlag As Boolean
Dim mbAddNewFlag As Boolean
Dim mbDataChanged As Boolean

Private Sub DComTitleId_Change()
    Dim qunt As Integer
    adoprimaryrs2.MoveFirst
    adoprimaryrs2.Find ("TitleId" & "='" & DComTitleId & "'")
    qunt = adoprimaryrs2.Fields(1)
    Combo2.Clear
    For i = 1 To qunt
        Combo2.AddItem (DComTitleId & "/" & i)
    Next i
    Combo2.ListIndex = 0
    txtFields(1).Text = Combo2.Text
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 TitleId,BookId,Condition,IsIn,MemberId,ReturnDate,IssueCounter,ReserveId,TypeIssue from Books", db, adOpenStatic, adLockOptimistic

    Set adoprimaryrs2 = New Recordset
    adoprimaryrs2.Open "select TitleId,Quantity from Titles", db, adOpenStatic, adLockOptimistic
  
    Dim oText As TextBox
    '綁定Textbox到數據源
    For Each oText In Me.txtFields
        Set oText.DataSource = adoprimaryrs
    Next
    Dim oCheck As CheckBox
    '綁定CheckBox到數據源
    For Each oCheck In Me.chkFields
        Set oCheck.DataSource = adoprimaryrs
    Next

    mbDataChanged = False
    Combo1.AddItem ("EXCELLENT")
    Combo1.AddItem ("GOOD")
    Combo1.AddItem ("POOR")
    Combo1.AddItem ("WORST")
    Combo1.AddItem ("MISSING")
    Combo1.ListIndex = 0
    
    comSearch.AddItem ("BookId")
    comSearch.AddItem ("TitleId")
    comSearch.AddItem ("MemberId")
    comSearch.AddItem ("ReserveId")
    comSearch.ListIndex = 0
    txtFields(0).Locked = True
    txtFields(1).Locked = True
    Set DComTitleId.DataSource = adoprimaryrs2
    Set DComTitleId.RowSource = adoprimaryrs2
    DComTitleId.ListField = "TitleId"
    If M.BooksCallByTitle Then
        cmdAdd_Click
    End If
 
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
    DComTitleId.Refresh
    With adoprimaryrs
        If Not (.BOF And .EOF) Then
            mvBookMark = .Bookmark
        End If
        .AddNew
        lblStatus.Caption = "Add record"
        mbAddNewFlag = True
        SetButtons False
    End With
    txtFields(6).Text = "0"
    txtFields(4) = "0"
    txtFields(7) = "0"
    Exit Sub
AddErr:
    MsgBox "發生錯誤：" & Err.Description, vbExclamation, "錯誤"
End Sub

Private Sub cmdDelete_Click()
    Dim q As Integer
On Error GoTo DeleteErr
    With adoprimaryrs
        .Delete
        .MoveNext
        If .EOF Then .MoveLast
    End With
    '更新Title表
    adoprimaryrs2.MoveFirst
    adoprimaryrs2.Find ("TitleId" & "='" & txtFields(0).Text & "'")
    q = adoprimaryrs2.Fields(1)
    q = q - 1
    adoprimaryrs2.Fields(1) = q
    adoprimaryrs2.Update
    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
    '不允許編輯時隱藏Combo
    Combo2.Visible = False
    DComTitleId.Visible = 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
    txtFields(2).Text = Combo1.Text
    txtFields(0).Text = DComTitleId.Text
    txtFields(1).Text = Combo2.Text

    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
    'show the current record
    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
    Combo1.Visible = Not bVal
    DComTitleId.Visible = Not bVal
    Combo2.Visible = Not bVal
End Sub

Private Sub txtFields_Change(Index As Integer)
    txtFields(Index).Text = UCase(Trim(txtFields(Index).Text))
End Sub