foKto close routines

Posted by greenheart on May Fri 4th 11:42 AM - Never Expires| View : 68
Syntax: TEXT
2256 characters | 104 lines | 2.2 KB
DOWNLOAD | RAW | EMBED | CREATE NEW VERSION OF THIS PASTE | REPORT ABUSE | x
  1. Public Function fOKToClose(pfDirty As Boolean) As Boolean
  2.   ' Comments  :
  3.   ' Parameters:
  4.   ' Returns   : Boolean -
  5.   ' Created   : 05/02/12 12:37 SW
  6.   ' Modified  :
  7.   '
  8.   ' --------------------------------------------------
  9.   'TVCodeTools ErrorEnablerStart
  10.   On Error GoTo PROC_ERR
  11.    If Not (gErr Is Nothing) Then
  12.      gErr.Push "basUtility:fOKToClose"
  13.    End If
  14.   'TVCodeTools ErrorEnablerEnd
  15.  
  16.  
  17.   If pfDirty Then
  18.     fOKToClose = fConfirmFormClose()
  19.   Else
  20.     fOKToClose = True
  21.   End If
  22.  
  23.   'TVCodeTools ErrorHandlerStart
  24. PROC_EXIT:
  25.   If Not (gErr Is Nothing) Then
  26.     gErr.Pop
  27.   End If
  28.   Exit Function
  29.  
  30. PROC_ERR:
  31.   If Not (gErr Is Nothing) Then
  32.     gErr.HandleError
  33.   Else
  34.     MsgBox Err.Description, vbOKOnly, "basUtility:fOKToClose"
  35.   End If
  36.  
  37.   If gfDebug Then
  38.     Stop
  39.     Resume
  40.   Else
  41.     Resume PROC_EXIT
  42.   End If
  43.   'TVCodeTools ErrorHandlerEnd
  44.  
  45. End Function
  46.  
  47. Public Function fConfirmFormClose() As Boolean
  48.   ' Comments  :
  49.   ' Parameters:
  50.   ' Returns   : Boolean -
  51.   ' Created   : 04/04/12 08:47 SW
  52.   ' Modified  :
  53.   '
  54.   ' --------------------------------------------------
  55.   'TVCodeTools ErrorEnablerStart
  56.   On Error GoTo PROC_ERR
  57.    If Not (gErr Is Nothing) Then
  58.      gErr.Push "basUtility:fConfirmFormClose"
  59.    End If
  60.   'TVCodeTools ErrorEnablerEnd
  61.  
  62.   Dim lngRetval As Long
  63.   Dim fRetval As Boolean
  64.  
  65.  
  66.   lngRetval = MsgBox("The changes you made have not been saved." & _
  67.               vbCrLf & "" & vbCrLf & "Do you want to exit anyway " & _
  68.               "and lose all changes?" & vbCrLf & "" & vbCrLf & "", _
  69.               vbOKCancel + vbQuestion + vbDefaultButton2, "Unsaved " & _
  70.               "Changes on Form")
  71.  
  72.   Select Case lngRetval
  73.     Case vbOK
  74.       fRetval = True
  75.     Case vbCancel
  76.   End Select
  77.  
  78.  
  79.   fConfirmFormClose = fRetval
  80.  
  81.   'TVCodeTools ErrorHandlerStart
  82. PROC_EXIT:
  83.   If Not (gErr Is Nothing) Then
  84.     gErr.Pop
  85.   End If
  86.   Exit Function
  87.  
  88. PROC_ERR:
  89.   If Not (gErr Is Nothing) Then
  90.     gErr.HandleError
  91.   Else
  92.     MsgBox Err.Description, vbOKOnly, "basUtility:fConfirmFormClose"
  93.   End If
  94.  
  95.   If gfDebug Then
  96.     Stop
  97.     Resume
  98.   Else
  99.     Resume PROC_EXIT
  100.   End If
  101.   'TVCodeTools ErrorHandlerEnd
  102.  
  103. End Function