Option Explicit
'>>>>>>>>>>>>>>>>>>>>>>>>
'ResMe Converted To A Property: Const BUTTON1 = "&Add"
'ResMe Converted To A Property: Const BUTTON2 = "&Edit"
'ResMe Converted To A Property: Const BUTTON3 = "&Delete"
'ResMe Converted To A Property: Const BUTTON4 = "&Close"
'ResMe Converted To A Property: Const BUTTON5 = "&Sort"
'ResMe Converted To A Property: Const BUTTON6 = "F&ilter"
'ResMe Converted To A Property: Const BUTTON7 = "&Move"
'ResMe Converted To A Property: Const BUTTON8 = "&Find"
'ResMe Converted To A Property: Const BUTTON9 = "&Cancel"
'ResMe Converted To A Property: Const BUTTON10 = "&Update"
'ResMe Converted To A Property: Const Label1 = "Field Name:"
'ResMe Converted To A Property: Const Label2 = "Value (F4=Zoom)"
'ResMe Converted To A Property: Const MSG1 = "Add record"
'ResMe Converted To A Property: Const MSG2 = "Enter number of Rows to Move:"
'ResMe Converted To A Property: Const MSG3 = "(Use negative value to move backwards)"
'ResMe Converted To A Property: Const MSG4 = "Field Length Exceeded, Data Truncated!"
'ResMe Converted To A Property: Const MSG5 = "Delete Current Record?"
'ResMe Converted To A Property: Const MSG6 = "Edit record"
'ResMe Converted To A Property: Const MSG7 = "Enter Filter Expression:"
'ResMe Converted To A Property: Const MSG8 = "Setting New Filter"
'ResMe Converted To A Property: Const MSG9 = "Enter Search Parameters"
'ResMe Converted To A Property: Const MSG10 = "Searching for New Record"
'ResMe Converted To A Property: Const MSG11 = "Record Not Found"
'ResMe Converted To A Property: Const MSG12 = "Resizing Form"
'ResMe Converted To A Property: Const MSG13 = "Enter Sort Column:"
'ResMe Converted To A Property: Const MSG14 = "Setting New Sort Order"
'>>>>>>>>>>>>>>>>>>>>>>>>


'form variables
Public mrsFormRecordset As Recordset
Dim msTableName As String      'form recordset table name
Dim mvBookMark As Variant       'form bookmark
Dim mbNotFound As Integer      'used by find function
Dim mbEditFlag As Integer      'edit mode
Dim mbAddNewFlag As Integer    'add mode
Dim mbDataChanged As Integer   'field data dirty flag
Dim mfrmFind As New frmFindForm      'find form instance
Dim mlNumRows As Long          'total rows in recordset

Private Sub cmdAdd_Click()
  On Error GoTo AddErr

  'set the mode
  mrsFormRecordset.AddNew
  lblStatus.Caption = MSG1
  mbAddNewFlag = True
  If mrsFormRecordset.RecordCount > 0 Then
    mvBookMark = mrsFormRecordset.Bookmark
  Else
    mvBookMark = vbNullString
  End If

  picChangeButtons.Visible = True
  picViewButtons.Visible = False
  hsclCurrRow.Enabled = False
  
  ClearDataFields Me, mrsFormRecordset.Fields.Count
  txtFieldData(0).SetFocus
  mbDataChanged = False
  Exit Sub

AddErr:
  ShowError
End Sub

Private Sub cmdCancel_Click()
   On Error Resume Next

   picChangeButtons.Visible = False
   picViewButtons.Visible = True
   hsclCurrRow.Enabled = True

   mbEditFlag = False
   mbAddNewFlag = False
   mrsFormRecordset.CancelUpdate
   DBEngine.Idle dbFreeLocks
   DisplayCurrentRecord Me, mrsFormRecordset, mlNumRows, mbAddNewFlag
   mbDataChanged = False

End Sub

Private Sub cmdMove_Click()
  On Error GoTo MVErr
  
  Dim sBookMark As String
  Dim sRows As String
  Dim lRows As Long
  
  sRows = InputBox(MSG2 & vbCrLf & MSG3)
  If Len(sRows) = 0 Then Exit Sub
  
  lRows = CLng(sRows)
  mrsFormRecordset.Move lRows
  
  'check to see if they moved past the bounds of the recordset
  If mrsFormRecordset.EOF Then
    mrsFormRecordset.MoveLast
  ElseIf mrsFormRecordset.BOF Then
    mrsFormRecordset.MoveFirst
  End If
  
  If hsclCurrRow.Value = mrsFormRecordset.PercentPosition Then Exit Sub
  
  sBookMark = mrsFormRecordset.Bookmark  'save the new position
  'now we need to reposition the scrollbar to reflect the move
  If mlNumRows > 32767 Then
    hsclCurrRow.Value = (mrsFormRecordset.PercentPosition * 32767) / 100 + 1
  ElseIf mlNumRows > 99 Then
    hsclCurrRow.Value = (mrsFormRecordset.PercentPosition * mlNumRows) / 100 + 1
  Else
    hsclCurrRow.Value = mrsFormRecordset.PercentPosition
  End If
  mrsFormRecordset.Bookmark = sBookMark
  
  Exit Sub
  
MVErr:
  ShowError
End Sub



Private Sub hsclCurrRow_Change()
  On Error GoTo SCRErr
  
  Static nPrevVal As Integer
  Dim rsTmp As Recordset

  'based on number of rows, there is different logic needed
  'to set the current position in the recordset
  If mlNumRows > 0 Then
    If mlNumRows > 99 Then   '32767 Then
      'if there are > 32767 we need to use the move methods because
      'the scrollbar is limited to 32767 so if we didn't apply this
      'logic, it would be impossible to get to every record on a
      'small change of the scrollbar
      If hsclCurrRow.Value - nPrevVal = 1 Then
        mrsFormRecordset.MoveNext
        If mrsFormRecordset.EOF Then
          mrsFormRecordset.MoveLast
        End If
      ElseIf hsclCurrRow.Value - nPrevVal = -1 Then
        mrsFormRecordset.MovePrevious
        If mrsFormRecordset.BOF Then
          mrsFormRecordset.MoveFirst
        End If
      Else
        If mlNumRows > 32767 Then
          mrsFormRecordset.PercentPosition = (hsclCurrRow.Value / 32767) * 100 + 0.005
        Else
          mrsFormRecordset.PercentPosition = (hsclCurrRow.Value / mlNumRows) * 100 + 0.005
        End If
      End If
      nPrevVal = hsclCurrRow.Value
    Else
      mrsFormRecordset.PercentPosition = hsclCurrRow.Value
    End If
  End If
  DisplayCurrentRecord Me, mrsFormRecordset, mlNumRows, mbAddNewFlag
  mbDataChanged = False

  Screen.MousePointer = vbDefault
  MsgBar vbNullString, False
  Exit Sub

SCRErr:
  ShowError
End Sub


Private Sub txtFieldData_Change(Index As Integer)
  'just set the flag if data is changed
  'it gets reset to false when a new record is displayed
  mbDataChanged = True
End Sub

Private Sub txtFieldData_KeyDown(Index As Integer, KeyCode As Integer, Shift As Integer)
  If KeyCode = &H73 Then   'F4
    lblFieldName_DblClick Index

  ElseIf KeyCode = 34 And vsbScrollBar.Visible Then
    'pagedown with > 10 fields
    vsbScrollBar.Value = vsbScrollBar.Value - 3000

  ElseIf KeyCode = 33 And vsbScrollBar.Visible Then
    'pageup with > 10 fields
    vsbScrollBar.Value = vsbScrollBar.Value + 3000

  End If
End Sub

Private Sub txtFieldData_KeyPress(Index As Integer, KeyAscii As Integer)
  'only allow return when in edit of add mode
  If mbEditFlag Or mbAddNewFlag Then
    If KeyAscii = 13 Then
      KeyAscii = 0
      SendKeys "{Tab}"
    End If

  'throw away the keystrokes if not in add or edit mode
  ElseIf mbEditFlag = False And mbAddNewFlag = False Then
    KeyAscii = 0
  End If

End Sub

Private Sub txtFieldData_LostFocus(Index As Integer)
  On Error GoTo FldDataErr

  If mbDataChanged Then
    'store the data in the field
    mrsFormRecordset(Index) = txtFieldData(Index)
  End If

  'reset for valid or error condition
  mbDataChanged = False
  Exit Sub

FldDataErr:
  'reset for valid or error condition
  mbDataChanged = False
  ShowError
End Sub

Private Sub lblFieldName_DblClick(Index As Integer)
  On Error GoTo ZoomErr

  If mrsFormRecordset(Index).Type = dbText Or mrsFormRecordset(Index).Type = dbMemo Then
     If mrsFormRecordset(Index).Type = dbText Then
       gsZoomData = txtFieldData(Index).Text
     ElseIf mrsFormRecordset(Index).FieldSize() < gnGETCHUNK_CUTOFF Then
       gsZoomData = txtFieldData(Index).Text
     Else
       'add the rest of the field data with getchunk
       MsgBar "Getting Memo Field Data", True
       Screen.MousePointer = vbHourglass
       gsZoomData = txtFieldData(Index).Text & _
         StripNonAscii(mrsFormRecordset(Index).GetChunk(gnGETCHUNK_CUTOFF, gnMAX_MEMO_SIZE))
       Screen.MousePointer = vbDefault
       MsgBar vbNullString, False
     End If
     frmZoom.Caption = Mid(lblFieldName(Index).Caption, 1, Len(lblFieldName(Index).Caption) - 1)
     If mbAddNewFlag Or mbEditFlag Then
       frmZoom.cmdSave.Visible = True
       frmZoom.cmdCloseNoSave.Visible = True
     Else
       frmZoom.cmdClose.Visible = True
     End If
     If mrsFormRecordset(Index).Type = dbText Then
       frmZoom.txtZoomData.Text = gsZoomData
       frmZoom.Height = 1125
     Else
       frmZoom.txtMemo.Text = gsZoomData
       frmZoom.txtMemo.Visible = True
       frmZoom.txtZoomData.Visible = False
       frmZoom.Height = 2205
     End If

     frmZoom.Show vbModal
     If (mbAddNewFlag Or mbEditFlag) And gsZoomData <> "__CANCELLED__" Then
       If mrsFormRecordset(Index).Type = dbText And Len(gsZoomData) > mrsFormRecordset(Index).Size Then
         Beep
         MsgBox MSG4, 48
         txtFieldData(Index).Text = Mid(gsZoomData, 1, mrsFormRecordset(Index).Size)
       Else
         txtFieldData(Index).Text = gsZoomData
       End If
       mrsFormRecordset(Index) = txtFieldData(Index).Text
       mbDataChanged = False
     End If
  End If
  Exit Sub

ZoomErr:
  ShowError
End Sub

Private Sub cmdClose_Click()
  DBEngine.Idle dbFreeLocks
  Unload Me
End Sub

Private Sub vsbScrollBar_Change()
  Dim nTop As Integer

  nTop = vsbScrollBar.Value
  If (nTop - 1080) Mod gnCTLARRAYHEIGHT = 0 Then
    picFields.Top = nTop
  Else
    picFields.Top = ((nTop - 1080) \ gnCTLARRAYHEIGHT) * gnCTLARRAYHEIGHT + 1080
  End If

End Sub

Private Sub cmdDelete_Click()
  On Error GoTo DelRecErr

  If MsgBox(MSG5, vbYesNo + vbQuestion) = vbYes Then
    mrsFormRecordset.Delete
    If gbTransPending Then gbDBChanged = True
    If mrsFormRecordset.EOF = False Then
      'see if we can move to the next record
      mrsFormRecordset.MoveNext
      If mrsFormRecordset.EOF And (mrsFormRecordset.RecordCount > 0) Then
        'must've been the last record so we can't move next
        mrsFormRecordset.MoveLast
      End If
    End If
    mlNumRows = mlNumRows - 1
    SetScrollBar
    mlNumRows = mrsFormRecordset.RecordCount
    DisplayCurrentRecord Me, mrsFormRecordset, mlNumRows, mbAddNewFlag
    mbDataChanged = False
  End If

  Exit Sub

DelRecErr:
  ShowError
End Sub

Private Sub cmdEdit_Click()
   On Error GoTo EditErr

  Dim nDelay As Long
  Dim nRetryCnt As Integer
  
  Screen.MousePointer = vbHourglass
RetryEdit:
   mrsFormRecordset.Edit
   lblStatus.Caption = MSG6
   mbEditFlag = True
   txtFieldData(0).SetFocus
   mvBookMark = mrsFormRecordset.Bookmark

   picChangeButtons.Visible = True
   picViewButtons.Visible = False
   hsclCurrRow.Enabled = False

   Screen.MousePointer = vbDefault
   Exit Sub

EditErr:
  If Err = 3260 And nRetryCnt < gnMURetryCnt Then
    nRetryCnt = nRetryCnt + 1
    DBEngine.Idle dbFreeLocks
    'Wait gnMUDelay seconds
    nDelay = Timer
    While Timer - nDelay < gnMUDelay
      'do nothing
    Wend
    Resume RetryEdit
  Else
    ShowError
  End If
End Sub

Private Sub cmdFilter_Click()
  On Error GoTo FilterErr

  Dim sBookMark As String
  Dim recRecordset1 As Recordset, recRecordset2 As Recordset
  Dim sFilterStr As String

  If mrsFormRecordset.RecordCount = 0 Then Exit Sub

  sBookMark = mrsFormRecordset.Bookmark        'save the bookmark
  Set recRecordset1 = mrsFormRecordset            'save the recordset
  
  sFilterStr = InputBox(MSG7)
  If Len(sFilterStr) = 0 Then Exit Sub

  Screen.MousePointer = vbHourglass
  MsgBar MSG8, True
  mrsFormRecordset.Filter = sFilterStr
  Set recRecordset2 = mrsFormRecordset.OpenRecordset(mrsFormRecordset.Type) 'establish the filter
  'force population to get an accurate recordcount
  recRecordset2.MoveLast
  recRecordset2.MoveFirst
  Set mrsFormRecordset = recRecordset2            'assign back to original recordset object

  'everything must be okay so redisplay form on 1st record
  mlNumRows = mrsFormRecordset.RecordCount
  SetScrollBar
  hsclCurrRow.Value = 0
  DisplayCurrentRecord Me, mrsFormRecordset, mlNumRows, mbAddNewFlag
  mbDataChanged = False
  Screen.MousePointer = vbDefault
  MsgBar vbNullString, False
  Exit Sub
  
FilterRecover:
  On Error Resume Next
  Set mrsFormRecordset = recRecordset1            're-assign back to original
  mrsFormRecordset.Bookmark = sBookMark           'go back to original record
  Exit Sub

FilterErr:
  ShowError
  Resume FilterRecover
End Sub

Private Sub cmdFind_Click()
  On Error GoTo FindErr
  
  Dim i As Integer
  Dim sBookMark As String
  Dim sTmp As String

  'load the column names into the find form
  If mfrmFind.lstFields.ListCount = 0 Then
    For i = 0 To mrsFormRecordset.Fields.Count - 1
      mfrmFind.lstFields.AddItem Mid(lblFieldName(i).Caption, 1, Len(lblFieldName(i).Caption) - 1)
    Next
  End If

FindStart:

  'reset the flags
  gbFindFailed = False
  gbFromTableView = False
  mbNotFound = False

  MsgBar MSG9, False
  mfrmFind.Show vbModal
  MsgBar MSG10, True
  If gbFindFailed Then    'find cancelled
    GoTo AfterWhile
  End If

  Screen.MousePointer = vbHourglass

  i = mfrmFind.lstFields.ListIndex
  sBookMark = mrsFormRecordset.Bookmark
  'search for the record
  If mrsFormRecordset(i).Type = dbText Or mrsFormRecordset(i).Type = dbMemo Then
    sTmp = AddBrackets((mrsFormRecordset(i).Name)) & " " & gsFindOp & " '" & gsFindExpr & "'"
  ElseIf mrsFormRecordset(i).Type = dbDate Then
    sTmp = AddBrackets((mrsFormRecordset(i).Name)) & " " & gsFindOp & " #" & gsFindExpr & "#"
  Else
    sTmp = AddBrackets((mrsFormRecordset(i).Name)) & gsFindOp & Val(gsFindExpr)
  End If
  Select Case gnFindType
    Case 0
      mrsFormRecordset.FindFirst sTmp
    Case 1
      mrsFormRecordset.FindNext sTmp
    Case 2
      mrsFormRecordset.FindPrevious sTmp
    Case 3
      mrsFormRecordset.FindLast sTmp
  End Select
  mbNotFound = mrsFormRecordset.NoMatch

AfterWhile:

  Screen.MousePointer = vbDefault

  If gbFindFailed Then    'go back to original row
    mrsFormRecordset.Bookmark = sBookMark
  ElseIf mbNotFound Then
    Beep
    MsgBox MSG11, 48
    mrsFormRecordset.Bookmark = sBookMark
    GoTo FindStart
  Else
    sBookMark = mrsFormRecordset.Bookmark  'save the new position
    'now we need to reposition the scrollbar to reflect the move
    If mlNumRows > 99 Then
      hsclCurrRow.Value = (mrsFormRecordset.PercentPosition * mlNumRows) / 100 + 1
    Else
      hsclCurrRow.Value = mrsFormRecordset.PercentPosition
    End If
    mrsFormRecordset.Bookmark = sBookMark
  End If

  DisplayCurrentRecord Me, mrsFormRecordset, mlNumRows, mbAddNewFlag
  mbDataChanged = False

  MsgBar vbNullString, False
  Exit Sub

FindErr:
  Screen.MousePointer = vbDefault
  If Err <> gnEOF_ERR Then
    ShowError
  Else
    mbNotFound = True
    Resume Next
  End If
End Sub

Private Sub Form_KeyUp(KeyCode As Integer, Shift As Integer)
  If KeyCode = vbKeyF1 And Shift = 0 Then
    DisplayTopic 2016125
  End If
End Sub

Private Sub Form_Load()
    'ResMe autogenerated line of code to call the initialization routine that was automatically generated.
    Call frmDynaSnap_Auto_Init
  Dim sTmp As String             'temp recordset name string
  Dim nFieldType As Integer      'field type of current field
  Dim i As Integer, j As Integer 'indexes

  On Error GoTo DynasetErr
   
   
  cmdAdd.Caption = BUTTON1
  cmdEdit.Caption = BUTTON2
  cmdDelete.Caption = BUTTON3
  cmdClose.Caption = BUTTON4
  cmdSort.Caption = BUTTON5
  cmdFilter.Caption = BUTTON6
  cmdMove.Caption = BUTTON7
  cmdFind.Caption = BUTTON8
  cmdCancel.Caption = BUTTON9
  cmdUpdate.Caption = BUTTON10
  lblFieldHdr.Caption = Label1
  lblFieldValue.Caption = Label2
  
  'mrsFormRecordset is a public module level variable
  'that must get set prior to 'Show'ing this form
   
   
  'set the locking type (comment out for standalone use)
  If gsDataType = gsMSACCESS And mrsFormRecordset.Type <> dbOpenSnapshot Then
    mrsFormRecordset.LockEdits = gnMULocking
  End If

  'get the row count
  With mrsFormRecordset
    If .RecordCount > 0 Then
      'move last, then first to get recordcount
      .MoveLast
      .MoveFirst
    End If
    mlNumRows = .RecordCount
  End With
  SetScrollBar

  'load the controls on the recordset form
  lblFieldName(0).Visible = True
  txtFieldData(0).Visible = True
  nFieldType = mrsFormRecordset(0).Type
  txtFieldData(0).Width = GetFieldWidth(nFieldType)
  If nFieldType = dbText Then txtFieldData(0).MaxLength = mrsFormRecordset(0).Size
  txtFieldData(0).TabIndex = 0
  For i = 1 To mrsFormRecordset.Fields.Count - 1
    picFields.Height = picFields.Height + gnCTLARRAYHEIGHT
    Load lblFieldName(i)
    lblFieldName(i).Top = lblFieldName(i - 1).Top + gnCTLARRAYHEIGHT
    lblFieldName(i).Visible = True
    Load txtFieldData(i)
    txtFieldData(i).Top = txtFieldData(i - 1).Top + gnCTLARRAYHEIGHT
    txtFieldData(i).Visible = True
    nFieldType = mrsFormRecordset.Fields(i).Type
    txtFieldData(i).Width = GetFieldWidth(nFieldType)
    If nFieldType = dbText Then txtFieldData(i).MaxLength = mrsFormRecordset(i).Size
    txtFieldData(i).TabIndex = i
  Next

  'resize main window
  Me.Width = 5580
  If i <= 10 Then
    Me.Height = ((i + 1) * gnCTLARRAYHEIGHT) + 1600
  Else
    Me.Height = 4368
    Me.Width = Me.Width + 260
    vsbScrollBar.Visible = True
    vsbScrollBar.Min = 1080
    vsbScrollBar.Max = 1080 - (i * gnCTLARRAYHEIGHT) + 2240
  End If

  'display the field names
  For i = 0 To mrsFormRecordset.Fields.Count - 1
    lblFieldName(i).Caption = mrsFormRecordset(i).Name & ":"
  Next

  DisplayCurrentRecord Me, mrsFormRecordset, mlNumRows, mbAddNewFlag
  mbDataChanged = False

  Me.Left = 1000
  Me.Top = 1000
  
  MsgBar vbNullString, False
  Exit Sub

DynasetErr:
  ShowError
  Unload Me
End Sub

Private Sub Form_Resize()
  On Error Resume Next

  Dim nHeight As Integer
  Dim i As Integer
  Dim nTotWidth As Integer
  Const nHeightFactor = 1420

  If WindowState <> 1 Then   'not minimized
    MsgBar MSG12, True
    'make sure the form is lined up on a field
    nHeight = Height
    If (nHeight - nHeightFactor) Mod gnCTLARRAYHEIGHT <> 0 Then
      Me.Height = ((nHeight - nHeightFactor) \ gnCTLARRAYHEIGHT) * gnCTLARRAYHEIGHT + nHeightFactor
    End If
    'resize the status bar
    picMoveButtons.Top = Me.Height - 650
    'resize the scrollbar
    vsbScrollBar.Height = picMoveButtons.Top - (picViewButtons.Top - picFldHdr.Height) - 1320
    vsbScrollBar.Left = Me.Width - 360
    If mrsFormRecordset.Fields.Count > 10 Then
      picFields.Width = Me.Width - 260
      nTotWidth = vsbScrollBar.Left - 20
    Else
      picFields.Width = Me.Width - 20
      nTotWidth = Me.Width - 50
    End If
    picFldHdr.Width = Me.Width - 20
    'widen the fields if possible
    For i = 0 To mrsFormRecordset.Fields.Count - 1
      lblFieldName(i).Width = 0.3 * nTotWidth
      txtFieldData(i).Left = lblFieldName(i).Width + 20
      If mrsFormRecordset(i).Type = dbText Or mrsFormRecordset(i).Type = dbMemo Then
        txtFieldData(i).Width = 0.7 * nTotWidth - 250
      End If
    Next
    lblFieldValue.Left = txtFieldData(0).Left
    hsclCurrRow.Width = picMoveButtons.Width \ 2
    lblStatus.Width = picMoveButtons.Width \ 2
    lblStatus.Left = hsclCurrRow.Width + 10
  End If
  MsgBar vbNullString, False
End Sub

Private Sub Form_Unload(Cancel As Integer)
  On Error Resume Next

  Unload mfrmFind   'get rid of attached find form
  mrsFormRecordset.Close          'close the form recordset
  DBEngine.Idle dbFreeLocks
  MsgBar vbNullString, False
End Sub

Private Sub cmdSort_Click()
  On Error GoTo SortErr

  Dim sBookMark As String
  Dim recRecordset1 As Recordset, recRecordset2 As Recordset
  Dim SortStr As String

  If mrsFormRecordset.RecordCount = 0 Then Exit Sub

  sBookMark = mrsFormRecordset.Bookmark        'save the bookmark
  Set recRecordset1 = mrsFormRecordset            'save the recordset
  
  SortStr = InputBox(MSG13)
  If Len(SortStr) = 0 Then Exit Sub

  Screen.MousePointer = vbHourglass
  MsgBar MSG14, True
  mrsFormRecordset.Sort = SortStr
  'establish the Sort
  Set recRecordset2 = mrsFormRecordset.OpenRecordset(mrsFormRecordset.Type)
  Set mrsFormRecordset = recRecordset2            'assign back to original recordset object

  'everything must be okay so redisplay form on 1st record
  mlNumRows = mrsFormRecordset.RecordCount
  hsclCurrRow.Value = 0
  DisplayCurrentRecord Me, mrsFormRecordset, mlNumRows, mbAddNewFlag
  mbDataChanged = False
  Screen.MousePointer = vbDefault
  MsgBar vbNullString, False
  Exit Sub

SortRecover:
  On Error Resume Next
  Set mrsFormRecordset = recRecordset1            're-assign back to original
  mrsFormRecordset.Bookmark = sBookMark        'go back to original record
  Exit Sub

SortErr:
  ShowError
  Resume SortRecover
End Sub

Private Sub cmdUpdate_Click()
  On Error GoTo UpdateErr

  Dim nDelay As Long
  Dim nRetryCnt As Integer

  Screen.MousePointer = vbHourglass
RetryUpd:
  mrsFormRecordset.Update
  If gbTransPending Then gbDBChanged = True

  If mbAddNewFlag Then
    mlNumRows = mlNumRows + 1
    SetScrollBar
    'move to the new record
    mrsFormRecordset.MoveLast
  End If

  picChangeButtons.Visible = False
  picViewButtons.Visible = True
  hsclCurrRow.Enabled = True
  mbEditFlag = False
  mbAddNewFlag = False
  hsclCurrRow_Change
  DBEngine.Idle dbFreeLocks

  Screen.MousePointer = vbDefault
  Exit Sub

UpdateErr:
  'check for locked error
  If Err = 3260 And nRetryCnt < gnMURetryCnt Then
    nRetryCnt = nRetryCnt + 1
    mrsFormRecordset.Bookmark = mrsFormRecordset.Bookmark   'Cancel the update
    DBEngine.Idle dbFreeLocks
    nDelay = Timer
    'Wait gnMUDelay seconds
    While Timer - nDelay < gnMUDelay
      'do nothing
    Wend
    Resume RetryUpd
  Else
    ShowError
  End If
End Sub

Private Sub SetScrollBar()
  On Error Resume Next
  
  If mlNumRows < 2 Then
    hsclCurrRow.Max = 100
    hsclCurrRow.SmallChange = 1 '00
    hsclCurrRow.LargeChange = 100
  ElseIf mlNumRows > 32767 Then
    hsclCurrRow.Max = 32767
    hsclCurrRow.SmallChange = 1
    hsclCurrRow.LargeChange = 1000
  ElseIf mlNumRows > 99 Then
    hsclCurrRow.Max = mlNumRows
    hsclCurrRow.SmallChange = 1
    hsclCurrRow.LargeChange = mlNumRows \ 20
  Else
    'must be between 2 and 100
    hsclCurrRow.Max = 100
    hsclCurrRow.SmallChange = 100 \ (mlNumRows - 1)
    hsclCurrRow.LargeChange = (100 \ (mlNumRows - 1)) * 10
  End If
  'move off, then back on to fix flashing bar
  txtFieldData(0).SetFocus
  hsclCurrRow.SetFocus
End Sub



'*********************************************************************************
'**          This Section Of Code Was Automatically Generated By ResMe          **
'**                                                                             **
'** String assignments to Constants have been converted to read-only properties **
'*********************************************************************************


'This was: Const BUTTON1 = "&Add"
Property Get BUTTON1 As String
    BUTTON1 = "&Add"
End Property

'This was: Const BUTTON2 = "&Edit"
Property Get BUTTON2 As String
    BUTTON2 = "&Edit"
End Property

'This was: Const BUTTON3 = "&Delete"
Property Get BUTTON3 As String
    BUTTON3 = "&Delete"
End Property

'This was: Const BUTTON4 = "&Close"
Property Get BUTTON4 As String
    BUTTON4 = "&Close"
End Property

'This was: Const BUTTON5 = "&Sort"
Property Get BUTTON5 As String
    BUTTON5 = "&Sort"
End Property

'This was: Const BUTTON6 = "F&ilter"
Property Get BUTTON6 As String
    BUTTON6 = "F&ilter"
End Property

'This was: Const BUTTON7 = "&Move"
Property Get BUTTON7 As String
    BUTTON7 = "&Move"
End Property

'This was: Const BUTTON8 = "&Find"
Property Get BUTTON8 As String
    BUTTON8 = "&Find"
End Property

'This was: Const BUTTON9 = "&Cancel"
Property Get BUTTON9 As String
    BUTTON9 = "&Cancel"
End Property

'This was: Const BUTTON10 = "&Update"
Property Get BUTTON10 As String
    BUTTON10 = "&Update"
End Property

'This was: Const Label1 = "Field Name:"
Property Get Label1 As String
    Label1 = "Field Name:"
End Property

'This was: Const Label2 = "Value (F4=Zoom)"
Property Get Label2 As String
    Label2 = "Value (F4=Zoom)"
End Property

'This was: Const MSG1 = "Add record"
Property Get MSG1 As String
    MSG1 = "Add record"
End Property

'This was: Const MSG2 = "Enter number of Rows to Move:"
Property Get MSG2 As String
    MSG2 = "Enter number of Rows to Move:"
End Property

'This was: Const MSG3 = "(Use negative value to move backwards)"
Property Get MSG3 As String
    MSG3 = "(Use negative value to move backwards)"
End Property

'This was: Const MSG4 = "Field Length Exceeded, Data Truncated!"
Property Get MSG4 As String
    MSG4 = "Field Length Exceeded, Data Truncated!"
End Property

'This was: Const MSG5 = "Delete Current Record?"
Property Get MSG5 As String
    MSG5 = "Delete Current Record?"
End Property

'This was: Const MSG6 = "Edit record"
Property Get MSG6 As String
    MSG6 = "Edit record"
End Property

'This was: Const MSG7 = "Enter Filter Expression:"
Property Get MSG7 As String
    MSG7 = "Enter Filter Expression:"
End Property

'This was: Const MSG8 = "Setting New Filter"
Property Get MSG8 As String
    MSG8 = "Setting New Filter"
End Property

'This was: Const MSG9 = "Enter Search Parameters"
Property Get MSG9 As String
    MSG9 = "Enter Search Parameters"
End Property

'This was: Const MSG10 = "Searching for New Record"
Property Get MSG10 As String
    MSG10 = "Searching for New Record"
End Property

'This was: Const MSG11 = "Record Not Found"
Property Get MSG11 As String
    MSG11 = "Record Not Found"
End Property

'This was: Const MSG12 = "Resizing Form"
Property Get MSG12 As String
    MSG12 = "Resizing Form"
End Property

'This was: Const MSG13 = "Enter Sort Column:"
Property Get MSG13 As String
    MSG13 = "Enter Sort Column:"
End Property

'This was: Const MSG14 = "Setting New Sort Order"
Property Get MSG14 As String
    MSG14 = "Setting New Sort Order"
End Property


Private Sub frmDynaSnap_Auto_Init()
'This routine initializes all User Interface control properties on frmDynaSnap.
'This section of code was automatically generated by the ResMe String Extraction Utility.
    Me.Caption = "Dynaset/Snapshot"
    cmdMove.Caption = "&Move"
    cmdSort.Caption = "&Sort"
    cmdFilter.Caption = "F&ilter"
    cmdClose.Caption = "&Close"
    cmdDelete.Caption = "&Delete"
    cmdEdit.Caption = "&Edit"
    cmdAdd.Caption = "&Add"
    cmdFind.Caption = "&Find"
    cmdUpdate.Caption = "&Update"
    cmdCancel.Caption = "&Cancel"
    lblFieldValue.Caption = " Value (F4=Zoom)"
    lblFieldHdr.Caption = "Field Name:"
End Sub