Option Compare Database
Option Explicit

' ============================================================
' : mFormNavigation
'
' :
'          Access.
'
' :
'   -    "5  35";
'   -     ;
'   -        "";
'   -   ;
'   -   ;
'   -   ;
'   -     ;
'   -     .
'
' :
'        .
'     .
' ============================================================


' ------------------------------------------------------------
'      .
'
' ,  Form_Current    
'    .
' ------------------------------------------------------------
Public gFormRecordOperationBusy As Boolean


Public Function GetFormRecordPositionText(ByVal frm As Access.Form) As String

    '      :
    '
    '   "5  35"      ;
    '   ""        ;
    '   "0  0"    ;
    '   ""    .

    On Error GoTo ErrorHandler

    Dim rs As DAO.Recordset
    Dim totalRecords As Long
    Dim currentRecordNumber As Long

    Set rs = frm.RecordsetClone

    If rs.EOF And rs.BOF Then

        If frm.NewRecord = True Then
            GetFormRecordPositionText = ""
        Else
            GetFormRecordPositionText = "0  0"
        End If

    Else

        rs.MoveLast
        totalRecords = rs.RecordCount

        If frm.NewRecord = True Then

            GetFormRecordPositionText = ""

        Else

            currentRecordNumber = frm.CurrentRecord
            GetFormRecordPositionText = currentRecordNumber & "  " & totalRecords

        End If

    End If

ExitPoint:

    On Error Resume Next

    If Not rs Is Nothing Then
        rs.Close
    End If

    Set rs = Nothing

    Exit Function

ErrorHandler:

    GetFormRecordPositionText = ""
    Resume ExitPoint

End Function


Public Function GetFormRecordCountByObject(ByVal frm As Access.Form) As Long

    '        .

    On Error GoTo ErrorHandler

    Dim rs As DAO.Recordset

    Set rs = frm.RecordsetClone

    If rs.EOF And rs.BOF Then

        GetFormRecordCountByObject = 0

    Else

        rs.MoveLast
        GetFormRecordCountByObject = rs.RecordCount

    End If

ExitPoint:

    On Error Resume Next

    If Not rs Is Nothing Then
        rs.Close
    End If

    Set rs = Nothing

    Exit Function

ErrorHandler:

    GetFormRecordCountByObject = 0
    Resume ExitPoint

End Function


Public Function MoveToRecordByPosition( _
    ByVal frm As Access.Form, _
    ByVal targetPosition As Long _
) As Boolean

    '       .

    On Error GoTo ErrorHandler

    Dim rs As DAO.Recordset

    MoveToRecordByPosition = False

    If targetPosition < 1 Then
        Exit Function
    End If

    Set rs = frm.RecordsetClone

    If rs.EOF And rs.BOF Then
        GoTo ExitPoint
    End If

    rs.MoveLast

    If targetPosition > rs.RecordCount Then
        GoTo ExitPoint
    End If

    rs.MoveFirst

    If targetPosition > 1 Then
        rs.Move targetPosition - 1
    End If

    If Not rs.EOF And Not rs.BOF Then
        frm.Bookmark = rs.Bookmark
        MoveToRecordByPosition = True
    End If

ExitPoint:

    On Error Resume Next

    If Not rs Is Nothing Then
        rs.Close
    End If

    Set rs = Nothing

    Exit Function

ErrorHandler:

    MoveToRecordByPosition = False
    Resume ExitPoint

End Function


Public Function ProcessPendingChangesBeforeNavigation(ByVal frm As Access.Form) As Boolean

    '      /.
    '
    ' :
    '   True     ;
    '   False    .

    On Error GoTo ErrorHandler

    Dim userAnswer As VbMsgBoxResult
    Dim rs As DAO.Recordset

    ProcessPendingChangesBeforeNavigation = False

    '       ,
    '       .
    If frm.NewRecord = True And frm.Dirty = False Then

        Set rs = frm.RecordsetClone

        If Not (rs.EOF And rs.BOF) Then
            rs.MoveLast
            frm.Bookmark = rs.Bookmark
        End If

        ProcessPendingChangesBeforeNavigation = False
        GoTo ExitPoint

    End If

    '      .
    If frm.Dirty = False Then
        ProcessPendingChangesBeforeNavigation = True
        GoTo ExitPoint
    End If

    userAnswer = MsgBox( _
        "   ." & vbCrLf & vbCrLf & _
        "   ?" & vbCrLf & vbCrLf & _
        "     ." & vbCrLf & _
        "     ." & vbCrLf & _
        "     .", _
        vbQuestion + vbYesNoCancel + vbDefaultButton1, _
        "  " _
    )

    Select Case userAnswer

        Case vbYes

            frm.Dirty = False
            ProcessPendingChangesBeforeNavigation = True

        Case vbNo

            frm.Undo

            If frm.NewRecord = True Then

                Set rs = frm.RecordsetClone

                If Not (rs.EOF And rs.BOF) Then
                    rs.MoveLast
                    frm.Bookmark = rs.Bookmark
                End If

                ProcessPendingChangesBeforeNavigation = False

            Else

                ProcessPendingChangesBeforeNavigation = True

            End If

        Case vbCancel

            ProcessPendingChangesBeforeNavigation = False

    End Select

ExitPoint:

    On Error Resume Next

    If Not rs Is Nothing Then
        rs.Close
    End If

    Set rs = Nothing

    Exit Function

ErrorHandler:

    ProcessPendingChangesBeforeNavigation = False
    Resume ExitPoint

End Function


Public Sub MoveToNextExistingRecord(ByVal frm As Access.Form)

    '     .
    '
    '         .

    On Error GoTo ErrorHandler

    Dim rs As DAO.Recordset
    Dim totalRecords As Long
    Dim currentPosition As Long
    Dim targetPosition As Long

    If ProcessPendingChangesBeforeNavigation(frm) = False Then
        GoTo ExitPoint
    End If

    Set rs = frm.RecordsetClone

    If rs.EOF And rs.BOF Then
        GoTo ExitPoint
    End If

    rs.MoveLast
    totalRecords = rs.RecordCount

    currentPosition = frm.CurrentRecord

    If currentPosition >= totalRecords Then
        GoTo ExitPoint
    End If

    targetPosition = currentPosition + 1

    rs.MoveFirst

    If targetPosition > 1 Then
        rs.Move targetPosition - 1
    End If

    frm.Bookmark = rs.Bookmark

ExitPoint:

    On Error Resume Next

    If Not rs Is Nothing Then
        rs.Close
    End If

    Set rs = Nothing

    Exit Sub

ErrorHandler:

    Resume ExitPoint

End Sub


Public Sub MoveToPreviousExistingRecord(ByVal frm As Access.Form)

    '     .
    '
    '     Access      .

    On Error GoTo ErrorHandler

    Dim rs As DAO.Recordset
    Dim totalRecords As Long
    Dim currentPosition As Long
    Dim targetPosition As Long

    If ProcessPendingChangesBeforeNavigation(frm) = False Then
        GoTo ExitPoint
    End If

    Set rs = frm.RecordsetClone

    If rs.EOF And rs.BOF Then
        GoTo ExitPoint
    End If

    rs.MoveLast
    totalRecords = rs.RecordCount

    currentPosition = frm.CurrentRecord

    If currentPosition <= 1 Then
        GoTo ExitPoint
    End If

    targetPosition = currentPosition - 1

    rs.MoveFirst

    If targetPosition > 1 Then
        rs.Move targetPosition - 1
    End If

    frm.Bookmark = rs.Bookmark

ExitPoint:

    On Error Resume Next

    If Not rs Is Nothing Then
        rs.Close
    End If

    Set rs = Nothing

    Exit Sub

ErrorHandler:

    Resume ExitPoint

End Sub


Public Function CreateNewFormRecord(ByVal frm As Access.Form) As Boolean

    '      .

    On Error GoTo ErrorHandler

    Dim stepName As String

    CreateNewFormRecord = False

    stepName = "  "

    If frm.AllowAdditions = False Then

        MsgBox "     .", _
               vbExclamation, _
               " "

        Exit Function

    End If

    stepName = "  "

    If frm.NewRecord = True Then

        MsgBox "    .", _
               vbInformation, _
               " "

        Exit Function

    End If

    stepName = "  "

    If frm.Dirty = True Then
        frm.Dirty = False
    End If

    stepName = " "

    On Error Resume Next
    frm.SetFocus
    Err.Clear
    On Error GoTo ErrorHandler

    stepName = "   "

    DoCmd.GoToRecord , , acNewRec

    CreateNewFormRecord = True

    Exit Function

ErrorHandler:

    CreateNewFormRecord = False

    MsgBox "      ." & vbCrLf & _
           ": " & stepName & vbCrLf & _
           ": " & Err.Description, _
           vbExclamation, _
           " "

End Function


Public Function SaveCurrentFormRecord(ByVal frm As Access.Form) As Boolean

    '       .

    On Error GoTo ErrorHandler

    Dim userAnswer As VbMsgBoxResult

    SaveCurrentFormRecord = False

    If frm.AllowEdits = False And frm.AllowAdditions = False Then

        MsgBox "     .", _
               vbExclamation, _
               " "

        Exit Function

    End If

    If frm.Dirty = False Then

        MsgBox "   .", _
               vbInformation, _
               " "

        SaveCurrentFormRecord = True
        Exit Function

    End If

    userAnswer = MsgBox( _
        "  ?" & vbCrLf & vbCrLf & _
        "   ." & vbCrLf & _
        "   ." & vbCrLf & _
        "    .", _
        vbQuestion + vbYesNoCancel + vbDefaultButton1, _
        " " _
    )

    Select Case userAnswer

        Case vbYes

            frm.Dirty = False
            SaveCurrentFormRecord = True

            MsgBox " .", _
                   vbInformation, _
                   " "

        Case vbNo

            frm.Undo
            SaveCurrentFormRecord = True

            MsgBox " .", _
                   vbInformation, _
                   " "

        Case vbCancel

            SaveCurrentFormRecord = False

    End Select

    Exit Function

ErrorHandler:

    SaveCurrentFormRecord = False

    MsgBox "    ." & vbCrLf & _
           ": " & Err.Description, _
           vbExclamation, _
           " "

End Function


Public Function DeleteCurrentFormRecord(ByVal frm As Access.Form) As Boolean

    '      .
    '
    '        ,
    '       .

    On Error GoTo ErrorHandler

    Dim stepName As String
    Dim rs As DAO.Recordset

    Dim totalBefore As Long
    Dim currentPosition As Long
    Dim movePosition As Long
    Dim targetPosition As Long
    Dim deleteBookmark As Variant

    DeleteCurrentFormRecord = False

    stepName = "  "

    If gFormRecordOperationBusy = True Then
        Exit Function
    End If

    stepName = "  "

    If frm.AllowDeletions = False Then

        MsgBox "     .", _
               vbExclamation, _
               " "

        Exit Function

    End If

    stepName = "  "

    If frm.NewRecord = True Then

        MsgBox "    .  .", _
               vbInformation, _
               " "

        Exit Function

    End If

    stepName = " "

    totalBefore = GetFormRecordCountByObject(frm)

    If totalBefore <= 0 Then
        Exit Function
    End If

    stepName = "  "

    If totalBefore = 1 Then

        MsgBox "   .", _
               vbInformation, _
               " "

        Exit Function

    End If

    stepName = "  "

    currentPosition = frm.CurrentRecord

    stepName = " "

    If MsgBox( _
        "  ?", _
        vbQuestion + vbYesNo + vbDefaultButton2, _
        " " _
    ) <> vbYes Then

        Exit Function

    End If

    stepName = "  "

    gFormRecordOperationBusy = True

    stepName = "  "

    If frm.Dirty = True Then
        frm.Undo
    End If

    stepName = "  "

    deleteBookmark = frm.Bookmark

    stepName = "  "

    If currentPosition = 1 Then
        movePosition = 2
        targetPosition = 1
    Else
        movePosition = currentPosition - 1
        targetPosition = currentPosition - 1
    End If

    stepName = "   "

    If MoveToRecordByPosition(frm, movePosition) = False Then
        Err.Raise vbObjectError + 1000, , "     ."
    End If

    stepName = " RecordsetClone"

    Set rs = frm.RecordsetClone

    stepName = "   "

    rs.Bookmark = deleteBookmark

    stepName = " "

    rs.Delete

    stepName = " "

    frm.Refresh

    stepName = "  "

    Call MoveToRecordByPosition(frm, targetPosition)

    DeleteCurrentFormRecord = True

ExitPoint:

    gFormRecordOperationBusy = False

    On Error Resume Next

    If Not rs Is Nothing Then
        rs.Close
    End If

    Set rs = Nothing

    Exit Function

ErrorHandler:

    gFormRecordOperationBusy = False

    DeleteCurrentFormRecord = False

    MsgBox "   ." & vbCrLf & _
           ": " & stepName & vbCrLf & _
           ": " & Err.Description, _
           vbExclamation, _
           " "

    Resume ExitPoint

End Function


Public Function GoToLastExistingRecord(ByVal frm As Access.Form) As Boolean

    '      .
    '
    '       .

    On Error GoTo ErrorHandler

    Dim rs As DAO.Recordset

    GoToLastExistingRecord = False

    Set rs = frm.RecordsetClone

    If rs.EOF And rs.BOF Then
        GoTo ExitPoint
    End If

    rs.MoveLast
    frm.Bookmark = rs.Bookmark

    GoToLastExistingRecord = True

ExitPoint:

    On Error Resume Next

    If Not rs Is Nothing Then
        rs.Close
    End If

    Set rs = Nothing

    Exit Function

ErrorHandler:

    GoToLastExistingRecord = False
    Resume ExitPoint

End Function