شخابيط ابو جودى : نموذج ازرار تنقل احترافى

[ابو جودي]

يمكن وضعه كنموذج فرعى داخل اى نموذج وسوف يعمل على الفور بدون ادنى تدخل 

الاكواد التى تمت كتابتها لهذا العمل 

Option Compare Database
Option Explicit

Private mHostForm       As Access.Form
Private mRecordCount    As Long
Private mIsInitialized  As Boolean
Private mLastPosition   As Long
Private mLastCount      As Long
Private mLastIsNew      As Boolean
Private mHasLastState   As Boolean

Private Sub Form_Load()
    InitializeNavigator
End Sub

Private Sub InitializeNavigator()
    If Not EnsureHostForm Then Exit Sub

    RefreshRecordCount True

    With mHostForm.Recordset
        If Not (.BOF And .EOF) Then .MoveFirst
    End With

    UpdateUI
    mIsInitialized = True
End Sub

Private Sub Form_Current()
    If mIsInitialized Then UpdateUI
End Sub

Private Function EnsureHostForm() As Boolean
    On Error GoTo ErrorHandler

    If mHostForm Is Nothing Then
        If TypeOf Me.Parent Is Form Then Set mHostForm = Me.Parent
    End If

ExitFunction:
    EnsureHostForm = Not (mHostForm Is Nothing)
    Exit Function

ErrorHandler:
    Set mHostForm = Nothing
    Resume ExitFunction
End Function

Private Function HasRecords() As Boolean
    HasRecords = (mRecordCount > 0)
End Function

Private Sub RefreshRecordCount(Optional ByVal force As Boolean = False)
    On Error GoTo ErrorHandler

    If Not EnsureHostForm Then
        mRecordCount = 0
        Exit Sub
    End If

    If Not force Then
        If mRecordCount > 0 Then Exit Sub
    End If

    With mHostForm.RecordsetClone
        If .BOF And .EOF Then
            mRecordCount = 0
        Else
            .MoveLast
            mRecordCount = .recordCount
        End If
    End With

ErrorHandler:
End Sub

Private Function GetCurrentPosition() As Long
    On Error GoTo ErrorHandler

    If Not EnsureHostForm Then
        GetCurrentPosition = 0
    ElseIf mRecordCount <= 0 Then
        GetCurrentPosition = 0
    ElseIf mHostForm.NewRecord Then
        GetCurrentPosition = mRecordCount + 1
    Else
        Dim pos As Long
        pos = mHostForm.CurrentRecord
        If pos <= 0 Then pos = 1
        GetCurrentPosition = pos
    End If

    Exit Function

ErrorHandler:
    GetCurrentPosition = 0
End Function

Private Sub UpdateUI()
    On Error GoTo SafeExit

    Dim frm As Form
    Dim currentPosition As Long
    Dim isEmpty As Boolean
    Dim isNew As Boolean
    Dim isFirst As Boolean
    Dim isLast As Boolean

    If Not EnsureHostForm Then
        If Not mHasLastState _
           Or mLastPosition <> 0 _
           Or mLastCount <> 0 _
           Or mLastIsNew <> False Then

            Me.lblRecordPosition.Caption = "0 of 0"
            Me.cmdGoFirst.Enabled = False
            Me.cmdGoPrevious.Enabled = False
            Me.cmdGoNext.Enabled = False
            Me.cmdGoLast.Enabled = False
            Me.cmdDeleteCurrent.Enabled = False

            mLastPosition = 0
            mLastCount = 0
            mLastIsNew = False
            mHasLastState = True
        End If
        Exit Sub
    End If

    Set frm = mHostForm
    currentPosition = GetCurrentPosition()
    isEmpty = (mRecordCount <= 0)
    isNew = frm.NewRecord

    If mHasLastState Then
        If mLastPosition = currentPosition _
           And mLastCount = mRecordCount _
           And mLastIsNew = isNew Then Exit Sub
    End If

    If isEmpty Then
        Me.lblRecordPosition.Caption = "0 of 0"
    Else
        Me.lblRecordPosition.Caption = currentPosition & " of " & mRecordCount
    End If

    isFirst = (currentPosition <= 1 And Not isNew)
    isLast = (currentPosition >= mRecordCount And Not isNew)

    Me.cmdGoFirst.Enabled = Not isEmpty And Not isFirst
    Me.cmdGoPrevious.Enabled = Not isEmpty And Not isFirst
    Me.cmdGoNext.Enabled = Not isEmpty And Not isLast And Not isNew
    Me.cmdGoLast.Enabled = Not isEmpty And Not isLast And Not isNew
    Me.cmdDeleteCurrent.Enabled = Not isEmpty And Not isNew

    mLastPosition = currentPosition
    mLastCount = mRecordCount
    mLastIsNew = isNew
    mHasLastState = True
    Exit Sub

SafeExit:
    Debug.Print "UpdateUI Error: "; Err.Number; " - "; Err.Description
End Sub

Private Sub cmdGoFirst_Click()
    If Not EnsureHostForm Then Exit Sub
    If Not HasRecords Then Exit Sub

    On Error GoTo ErrorHandler
    With mHostForm.RecordsetClone
        .MoveFirst
        mHostForm.Bookmark = .Bookmark
    End With
    UpdateUI
    Exit Sub

ErrorHandler:
    HandleNavigatorError Err.Number, Err.Description
End Sub

Private Sub cmdGoPrevious_Click()
    If Not EnsureHostForm Then Exit Sub
    If Not HasRecords Then Exit Sub

    If mHostForm.NewRecord Then
        cmdGoLast_Click
        Exit Sub
    End If

    On Error GoTo ErrorHandler

    With mHostForm.RecordsetClone
        .Bookmark = mHostForm.Bookmark

        If mHostForm.CurrentRecord > 1 Then
            .MovePrevious
            mHostForm.Bookmark = .Bookmark
        End If
    End With

    UpdateUI
    Exit Sub

ErrorHandler:
    HandleNavigatorError Err.Number, Err.Description
End Sub

Private Sub cmdGoNext_Click()
    If Not EnsureHostForm Then Exit Sub
    If Not HasRecords Then Exit Sub
    If mHostForm.NewRecord Then Exit Sub

    On Error GoTo ErrorHandler

    If mHostForm.CurrentRecord >= mRecordCount Then
        UpdateUI
        Exit Sub
    End If

    With mHostForm.RecordsetClone
        .Bookmark = mHostForm.Bookmark
        .MoveNext
        If Not .EOF Then mHostForm.Bookmark = .Bookmark
    End With

    UpdateUI
    Exit Sub

ErrorHandler:
    HandleNavigatorError Err.Number, Err.Description
End Sub

Private Sub cmdGoLast_Click()
    If Not EnsureHostForm Then Exit Sub
    If Not HasRecords Then Exit Sub

    On Error GoTo ErrorHandler
    With mHostForm.RecordsetClone
        .MoveLast
        mHostForm.Bookmark = .Bookmark
    End With
    UpdateUI
    Exit Sub

ErrorHandler:
    HandleNavigatorError Err.Number, Err.Description
End Sub

Private Sub cmdCreateNew_Click()
    On Error GoTo ErrorHandler

    If Not EnsureHostForm Then Exit Sub

    mHostForm.SetFocus
    DoCmd.GoToRecord acDataForm, mHostForm.name, acNewRec

    RefreshRecordCount True
    UpdateUI
    Exit Sub

ErrorHandler:
    HandleNavigatorError Err.Number, Err.Description
End Sub

Private Sub cmdDeleteCurrent_Click()
    If Not EnsureHostForm Then Exit Sub
    If Not HasRecords Then Exit Sub
    If mHostForm.NewRecord Then Exit Sub

    If MsgBox("هل تريد حذف السجل الحالي نهائيًا؟", vbYesNo + vbQuestion + vbDefaultButton2, "تأكيد الحذف") <> vbYes Then Exit Sub

    On Error GoTo ErrorHandler

    Dim rsClone As DAO.Recordset
    Dim bm As Variant
    Dim nextBM As Variant

    Set rsClone = mHostForm.RecordsetClone

    bm = mHostForm.Bookmark

    rsClone.Bookmark = bm
    rsClone.MoveNext

    If rsClone.EOF Then
        rsClone.Bookmark = bm
        rsClone.MovePrevious

        If rsClone.BOF Then
            nextBM = Null
        Else
            nextBM = rsClone.Bookmark
        End If
    Else
        nextBM = rsClone.Bookmark
    End If

    If mHostForm.Dirty Then
        mHostForm.Dirty = False
    End If

    mHostForm.Recordset.Delete
    RefreshRecordCount True

    If IsNull(nextBM) Then
        mHostForm.SetFocus
        DoCmd.GoToRecord , , acNewRec
    Else
        mHostForm.Bookmark = nextBM
    End If

    rsClone.Close
    Set rsClone = Nothing

    UpdateUI
    Exit Sub

ErrorHandler:
    On Error Resume Next
    If Not rsClone Is Nothing Then
        rsClone.Close
        Set rsClone = Nothing
    End If
    HandleNavigatorError Err.Number, Err.Description
End Sub

Private Sub HandleNavigatorError(ByVal errorNumber As Long, ByVal errorDescription As String)
    Select Case errorNumber
        Case 0, 3021
            Exit Sub
        Case Else
            MsgBox "حدث خطأ رقم " & errorNumber & vbCrLf & errorDescription, vbExclamation, "خطأ في أداة التنقل"
    End Select
End Sub

 

Navigator.accdb

[عسل قليل الدسم]

19 دقائق مضت, ابو جودي said:

يمكن وضعه كنموذج فرعى داخل اى نموذج وسوف يعمل على الفور بدون ادنى تدخل 

 

فكرة رائعة